How to save Specific worksheets from a workbook using VBA? - vba

Question

Objective:
To save specific worksheets in a workbook as unique CSV files
Conditions:
To save specific worksheets (plural) from a workbook that contains both the specific worksheets and extraneous worksheets (e.g. to save specific 10 out of 20 available worksheets)
Insert the current date into the CSV's file name in order to avoid overwriting files currently in the save folder (this VBA is run daily)
File name syntax: CurrentDate_WorksheetName.csv
I've found VBA code that gets me half way to my goal. It saves ALL worksheets in the workbook but the file name is not dynamic with the current date.
Current Code:
Private Sub SaveWorksheetsAsCsv()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim DateToday As Range
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "S:\test\"
For Each WS In ThisWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
' about overwriting the original file.
End Sub

Answer 1

There are several issues with your code:
i) There is no reason to save the format or name of your current workbook. Just use a new workbook to save the CSVs that you want.
ii) You were copying each worksheet in the book, but not copying it anywhere. This code was actually saving the same workbook with the name of each sheet. Copying the worksheet doesn't paste it anywhere and doesn't actually tell the saving function only to use parts of the document.
iii) To put the date in the name, you just need to append it to the save name string, as below.
Dim myWorksheets() As String 'Array to hold worksheet names to copy
Dim newWB As Workbook
Dim CurrWB As Workbook
Dim i As Integer
Set CurrWB = ThisWorkbook
SaveToDirectory = "S:\test\"
myWorksheets = Split("SheetName1, SheetName2, SheetName3", ",")
'this contains an array of the sheets.
'If you want more, put another comma and then the next sheet name.
'You need to put the real sheet names here.
For i = LBound(myWorksheets) To UBound(myWorksheets) 'Go through entire array
Set newWB = Workbooks.Add 'Create new workbook
CurrWB.Sheets(Trim(myWorksheets(i))).Copy Before:=newWB.Sheets(1)
'Copy worksheet to new workbook
newWB.SaveAs Filename:=SaveToDirectory & Format(Date, "yyyymmdd") & myWorksheets(i), FileFormat:=xlCSV
'Save new workbook in csv format to requested directory including date.
newWB.Close saveChanges:=False
'Close new workbook without saving (it is already saved)
Next i
CurrWB.Save 'save original workbook.
End Sub

Answer 2

It seems to me that in that code was a lot of unnecessary stuff but the most important part was almost ready.
Try this:
Sub SaveWorksheetsAsCsv()
Dim WS As Worksheet
Dim SaveToDirectory As String
SaveToDirectory = "C:\tmp\"
Application.DisplayAlerts = False
For Each WS In ThisWorkbook.Worksheets
WS.SaveAs Filename:=SaveToDirectory & Format(Now(), "yyyymmdd") & "_" & WS.Name & ".csv", FileFormat:=xlCSV
Next
Application.DisplayAlerts = True
End Sub