Saving excel worksheet to CSV files with filename+worksheet name using VB [duplicate] - vba

Question

This question already has answers here:
Export each sheet to a separate csv file
(2 answers)
Closed 8 years ago.
I am very new with VB coding, I am trying to save multiple excel file worksheets to csv, I don't know to do this for multiple sheets, but I found a way to do for single file. I have found code on this site which are very useful for what I am trying to do, only problem is the files are saved with the worksheet name but I am trying to save them with the original file and worksheet name such as filename_worksheet name, I tried to do that myself but keep getting error, could you please advise what I am doing wrong?
The code I am using is as follows:
Public Sub SaveWorksheetsAsCsv()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "H:\test\"
For Each WS In ThisWorkbook.Worksheets
WS.SaveAs SaveToDirectory & WS.Name, xlCSV
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

I think this is what you want...
Sub SaveWorksheetsAsCsv()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "H:\test\"
For Each WS In Application.ActiveWorkbook.Worksheets
WS.SaveAs SaveToDirectory & WS.Name, xlCSV
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 2

I had a similar problem. Data in a worksheet I needed to save as a separate CSV file.
Here's my code behind a command button
Private Sub cmdSave()
Dim sFileName As String
Dim WB As Workbook
Application.DisplayAlerts = False
sFileName = "MyFileName.csv"
'Copy the contents of required sheet ready to paste into the new CSV
Sheets(1).Range("A1:T85").Copy 'Define your own range
'Open a new XLS workbook, save it as the file name
Set WB = Workbooks.Add
With WB
.Title = "MyTitle"
.Subject = "MySubject"
.Sheets(1).Select
ActiveSheet.Paste
.SaveAs "MyDirectory\" & sFileName, xlCSV
.Close
End With
Application.DisplayAlerts = True
End Sub
This works for me :-)

Answer 3

Is this what you are trying?
Option Explicit
Public Sub SaveWorksheetsAsCsv()
Dim WS As Worksheet
Dim SaveToDirectory As String, newName As String
SaveToDirectory = "H:\test\"
For Each WS In ThisWorkbook.Worksheets
newName = GetBookName(ThisWorkbook.Name) & "_" & WS.Name
WS.Copy
ActiveWorkbook.SaveAs SaveToDirectory & newName, xlCSV
ActiveWorkbook.Close Savechanges:=False
Next
End Sub
Function GetBookName(strwb As String) As String
GetBookName = Left(strwb, (InStrRev(strwb, ".", -1, vbTextCompare) - 1))
End Function

Answer 4

Best way to find out is to record the macro and perform the exact steps and see what VBA code it generates. you can then go and replace the bits you want to make generic (i.e. file names and stuff)

Answer 5

The code above works perfectly with one minor flaw; the resulting file is not saved with a .csv extension. – Tensigh 2 days ago
I added the following to code and it saved my file as a csv. Thanks for this bit of code.It all worked as expected.
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV