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
CodePudding user response:
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