CODEWITHSUNDEEP
excelvbaexport-to-csv
Pontis
Pontis

Reputation: 397

Excel & VBA: efficiently save multiple worksheets to CSV

Assume that I have a workbook MyFile.xlsm with some worksheets (e.g. SheetA and SheetB) and I want to export the content of the worksheets into individual CSV files if the workbook is saved. (My question is similar to this one, but addresses multiple worksheets.) I came up with the code below, which works but takes some time since a new workbook is created via ws.Copy for each worksheet).

Is there a more efficient way to do this? Originally, I wanted to use the method Workbook.SaveCopyAs, but the latter does not allow saving to CSV. Moreover, I could not figure out how to use SaveAs without copying, since without copying SaveAs activates the newly saved CSV file as the current workbook (and therefore messes up the name and the other worksheets). So, what is the proper way of exporting multiple worksheets to CSV files?

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
If Success = True Then
    For Each ws In ThisWorkbook.Worksheets

        With Application
            .EnableEvents = False      ' prevent repeatedly calling this routine
            .DisplayAlerts = False     ' suppress prompt for overwriting existing CSV files
            .ScreenUpdating = False    ' speed up and prevent screen flickering
        End With

        Filename = Replace(ActiveWorkbook.FullName, ".xlsm", "") & "_" & ws.Name & ".csv"
        ws.Copy
        ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=xlCSVUTF8, Local:=True
        ActiveWorkbook.Close

        With Application
            .EnableEvents = True
            .DisplayAlerts = True
            .ScreenUpdating = True
        End With

    Next
    
End If
End Sub

Upvotes: 1

Views: 642

Answers (1)

DS_London
DS_London

Reputation: 4271

Amending this SO answer, "roll your own" CSV writing. Iterate through the Worksheets in the Workbook, giving each a different name.

Option Explicit

Public Sub SaveAllWorksheetsAsCsv()
    Dim wb As Workbook
    Dim ws As Worksheet
    
    Set wb = ActiveWorkbook
    
    Dim filenameBase As String
    filenameBase = Replace(wb.FullName, ".xlsm", "")
    
    For Each ws In wb.Worksheets
        WriteCsv filenameBase & "_" & ws.Name & ".csv", ws
    Next ws
End Sub


Private Sub WriteCsv(ByVal filename As String, ByRef ws As Worksheet)
    Dim v As Variant
    Dim vc As Variant
    Dim r As Integer
    Dim c As Integer

    Open filename For Output As #1

    v = ws.UsedRange

    ReDim vc(1 To UBound(v, 2)) As Variant

    For r = 1 To UBound(v, 1)
        For c = 1 To UBound(v, 2)
            vc(c) = v(r, c)
        Next c
        Print #1, Join(vc, ",")
    Next r

    Close #1
End Sub

Upvotes: 2

Related Questions