Export Multiple Sheets to CSV

user_2092236 0
Viewed 109

I am using this code which exports activesheet to CSV. However, I am looking to modify this so I can pass as arguments the names of multiple sheets to export.

Sometimes it could be 2 sheets, sometimes it could be 10 sheets and I want to somehow define the names of the sheets as parameters for the export.

Sub saveSheetToCSV()

    Dim myCSVFileName As String
    Dim tempWB As Workbook

    Application.DisplayAlerts = False
    On Error GoTo err

    myCSVFileName = ThisWorkbook.Path & "\" & "CSV-Exported-File-" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"

    ThisWorkbook.Sheets("YourSheetToCopy").Activate
    ActiveSheet.Copy
    Set tempWB = ActiveWorkbook

    With tempWB
    .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
    .Close
    End With
err:
    Application.DisplayAlerts = True
End Sub
vba excel
1 Answers

Export Worksheet to New Workbook

  • !!! denotes places to be checked carefully and possibly modified.
Option Explicit


Sub ExportWorksheetsTEST()
 
    Dim wb As Workbook: Set wb = Workbooks.Open("C:\Test\Test.xlsx")
    ExportWorksheets "Sheet1", "Sheet5", "Sheet8"

End Sub


Sub ExportWorksheets(ParamArray WorkSheetNames() As Variant)

    Dim dFolderPath As String: dFolderPath = ThisWorkbook.Path & "\"
    Const dFileExtension As String = ".csv"
    Const dDateFormat As String = "dd-MMM-yyyy hh-mm"
    Const dFileNameDelimiter As String = "-"

    ' This is the requirement.
    ' The recommendation is to put it as the first parameter of the procedure:
    ' Sub ExportWorksheets(ByVal wb As Workbook, ParamArray...)!!!
    Dim wb As Workbook: Set wb = ActiveWorkbook
    
    Dim dDateString As String: dDateString = VBA.Format(VBA.Now, dDateFormat)
    
    Dim ws As Worksheet
    Dim n As Long
    Dim dFilePath As String
    
    For n = LBound(WorkSheetNames) To UBound(WorkSheetNames)
        On Error Resume Next ' prevent error if worksheet doesn't exist
            Set ws = wb.Worksheets(WorkSheetNames(n))
        On Error GoTo 0
        If Not ws Is Nothing Then
            ' Build the file path!!!
            dFilePath = dFolderPath & ws.Name & dFileNameDelimiter _
                & dDateString & dFileExtension
            ws.Copy ' copy to a new workbook
            With Workbooks(Workbooks.Count)
                Application.DisplayAlerts = False ' overwrite w/o confirmation
                .SaveAs Filename:=dFilePath, FileFormat:=xlCSV
                Application.DisplayAlerts = True
                .Close SaveChanges:=False
            End With
            Set ws = Nothing
        End If
    Next n
    
    MsgBox "Worksheets exported.", vbInformation

End Sub
user_98140690
Related