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

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


I think this is what you want...

Sub SaveWorksheetsAsCsv()Dim WS As Excel.WorksheetDim SaveToDirectory As StringDim CurrentWorkbook As StringDim CurrentFormat As LongCurrentWorkbook = ThisWorkbook.FullNameCurrentFormat = ThisWorkbook.FileFormat' Store current details for the workbookSaveToDirectory = "H:\test\"For Each WS In Application.ActiveWorkbook.Worksheets    WS.SaveAs SaveToDirectory & WS.Name, xlCSVNextApplication.DisplayAlerts = FalseThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormatApplication.DisplayAlerts = True' Temporarily turn alerts off to prevent the user being prompted'  about overwriting the original file.End Sub


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 = TrueEnd Sub

This works for me :-)


Is this what you are trying?

Option ExplicitPublic 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    NextEnd SubFunction GetBookName(strwb As String) As String    GetBookName = Left(strwb, (InStrRev(strwb, ".", -1, vbTextCompare) - 1))End Function