Save each sheet in a workbook to separate CSV files

Question

How do I save each sheet in an Excel workbook to separate CSV files with a macro   I have an excel with multiple sheets and I was looking for a macro that will save each sheet to a separate CSV  comma separated file   Excel will not allow you to save all sheets to different CSV files

User · Accepted Answer

Here is one that will give you a visual file chooser to pick the folder you want to save the files to and also lets you choose the CSV delimiter  I use pipes     because my fields contain commas and I don t want to deal with quotes      ---------------------- Directory Choosing Helper Functions -----------------------   Excel and VBA do not provide any convenient directory chooser or file chooser   dialogs  but these functions will provide a reference to a system DLL   with the necessary capabilities Private Type BROWSEINFO      used by the function GetFolderName     hOwner As Long     pidlRoot As Long     pszDisplayName As String     lpszTitle As String     ulFlags As Long     lpfn As Long     lParam As Long     iImage As Long End Type  Private Declare Function SHGetPathFromIDList Lib  shell32 dll                                                 Alias  SHGetPathFromIDListA   ByVal pidl As Long  ByVal pszPath As String  As Long Private Declare Function SHBrowseForFolder Lib  shell32 dll                                               Alias  SHBrowseForFolderA   lpBrowseInfo As BROWSEINFO  As Long  Function GetFolderName Msg As String  As String       returns the name of the folder selected by the user     Dim bInfo As BROWSEINFO  path As String  r As Long     Dim X As Long  pos As Integer     bInfo pidlRoot   0 amp       Root folder   Desktop     If IsMissing Msg  Then         bInfo lpszTitle    Select a folder             the dialog title     Else         bInfo lpszTitle   Msg      the dialog title     End If     bInfo ulFlags    amp H1      Type of directory to return     X   SHBrowseForFolder bInfo       display the dialog       Parse the result     path   Space  512      r   SHGetPathFromIDList ByVal X  ByVal path      If r Then         pos   InStr path  Chr  0           GetFolderName   Left path  pos - 1      Else         GetFolderName          End If End Function  ---------------------- END Directory Chooser Helper Functions ----------------------  Public Sub DoTheExport       Dim FName As Variant     Dim Sep As String     Dim wsSheet As Worksheet     Dim nFileNum As Integer     Dim csvPath As String       Sep   InputBox  Enter a single delimiter character  e g   comma or semi-colon                          Export To Text File        csvPath   InputBox  Enter the full path to export CSV files to          csvPath   GetFolderName  Choose the folder to export CSV files to        If csvPath      Then         MsgBox   You didn t choose an export directory  Nothing will be exported            Exit Sub     End If      For Each wsSheet In Worksheets         wsSheet Activate         nFileNum   FreeFile         Open csvPath  amp       amp                 wsSheet Name  amp    csv  For Output As  nFileNum         ExportToTextFile CStr nFileNum   Sep  False         Close nFileNum     Next wsSheet  End Sub    Public Sub ExportToTextFile nFileNum As Integer                                Sep As String  SelectionOnly As Boolean       Dim WholeLine As String     Dim RowNdx As Long     Dim ColNdx As Integer     Dim StartRow As Long     Dim EndRow As Long     Dim StartCol As Integer     Dim EndCol As Integer     Dim CellValue As String      Application ScreenUpdating   False     On Error GoTo EndMacro       If SelectionOnly   True Then         With Selection             StartRow    Cells 1  Row             StartCol    Cells 1  Column             EndRow    Cells  Cells Count  Row             EndCol    Cells  Cells Count  Column         End With     Else         With ActiveSheet UsedRange             StartRow    Cells 1  Row             StartCol    Cells 1  Column             EndRow    Cells  Cells Count  Row             EndCol    Cells  Cells Count  Column         End With     End If      For RowNdx   StartRow To EndRow         WholeLine              For ColNdx   StartCol To EndCol             If Cells RowNdx  ColNdx  Value      Then                 CellValue                  Else                 CellValue   Cells RowNdx  ColNdx  Value             End If             WholeLine   WholeLine  amp  CellValue  amp  Sep         Next ColNdx         WholeLine   Left WholeLine  Len WholeLine  - Len Sep           Print  nFileNum  WholeLine     Next RowNdx  EndMacro      On Error GoTo 0     Application ScreenUpdating   True  End Sub

User · Answer

And here s my solution should work with Excel   2000  but tested only on 2007   Private Sub SaveAllSheetsAsCSV   On Error GoTo Heaven    each sheet reference Dim Sheet As Worksheet   path to output to Dim OutputPath As String   name of each csv Dim OutputFile As String  Application ScreenUpdating   False Application DisplayAlerts   False Application EnableEvents   False    ask the user where to save OutputPath   InputBox  Enter a directory to save to    Save to directory   Path   If OutputPath  lt  gt     Then        save for each sheet     For Each Sheet In Sheets          OutputFile   OutputPath  amp       amp  Sheet Name  amp    csv             make a copy to create a new book with this sheet           otherwise you will always only get the first sheet         Sheet Copy           this copy will now become active         ActiveWorkbook SaveAs FileName  OutputFile  FileFormat  xlCSV  CreateBackup  False         ActiveWorkbook Close     Next  End If  Finally  Application ScreenUpdating   True Application DisplayAlerts   True Application EnableEvents   True  Exit Sub  Heaven  MsgBox  Couldn t save all sheets to CSV    amp  vbCrLf  amp             Source     amp  Err Source  amp       amp  vbCrLf  amp             Number     amp  Err Number  amp       amp  vbCrLf  amp             Description     amp  Err Description  amp       amp  vbCrLf  GoTo Finally End Sub    OT  I wonder if SO will replace some of my minor blogging

User · Answer

For Mac users like me  there are several gotchas   You cannot save to any directory you want  Only few of them can receive your saved files  More info there  Here is a working script that you can copy paste in your excel for Mac   Public Sub SaveWorksheetsAsCsv     Dim WS As Excel Worksheet  Dim SaveToDirectory As String   SaveToDirectory      Library Containers com microsoft Excel Data     For Each WS In ThisWorkbook Worksheet     WS SaveAs SaveToDirectory  amp  WS Name  amp    csv   xlCSV  Next  End Sub

User · Answer

AlexDuggleby  you don t need to copy the worksheets  you can save them directly  e g    Public Sub SaveWorksheetsAsCsv   Dim WS As Excel Worksheet Dim SaveToDirectory As String      SaveToDirectory    C         For Each WS In ThisWorkbook Worksheets         WS SaveAs SaveToDirectory  amp  WS Name  xlCSV     Next  End Sub   Only potential problem is that that leaves your workbook saved as the last csv file  If you need to keep the original workbook you will need to SaveAs it

User · Answer

Use Visual Basic to loop through worksheets and save  csv files   Open up  xlsx file in Excel   Press option F11  Insert   Module  Insert this into the module code  Public Sub SaveWorksheetsAsCsv     Dim WS As Excel Worksheet  Dim SaveToDirectory As String   SaveToDirectory    quot    quot    For Each WS In ThisWorkbook Worksheets     WS SaveAs SaveToDirectory  amp  WS Name  amp   quot  csv quot   xlCSV  Next  End Sub   Find your  csv files in   Library Containers com microsoft Excel Data  open   Library Containers com microsoft Excel Data   Close  xlsx file   Rinse and repeat for other  xlsx files

User · Answer

A small modification to answer from Alex is turning on and off of auto calculation    Surprisingly the unmodified code was working fine with VLOOKUP but failed with OFFSET  Also turning auto calculation off speeds up the save drastically   Public Sub SaveAllSheetsAsCSV   On Error GoTo Heaven    each sheet reference Dim Sheet As Worksheet   path to output to Dim OutputPath As String   name of each csv Dim OutputFile As String  Application ScreenUpdating   False Application DisplayAlerts   False Application EnableEvents   False    Save the file in current director OutputPath   ThisWorkbook Path   If OutputPath  lt  gt     Then Application Calculation   xlCalculationManual    save for each sheet For Each Sheet In Sheets      OutputFile   OutputPath  amp  Application PathSeparator  amp  Sheet Name  amp    csv         make a copy to create a new book with this sheet       otherwise you will always only get the first sheet      Sheet Copy       this copy will now become active      ActiveWorkbook SaveAs Filename  OutputFile  FileFormat  xlCSV      CreateBackup  False     ActiveWorkbook Close Next  Application Calculation   xlCalculationAutomatic  End If  Finally  Application ScreenUpdating   True Application DisplayAlerts   True Application EnableEvents   True  Exit Sub  Heaven  MsgBox  Couldn t save all sheets to CSV    amp  vbCrLf  amp             Source     amp  Err Source  amp       amp  vbCrLf  amp             Number     amp  Err Number  amp       amp  vbCrLf  amp             Description     amp  Err Description  amp       amp  vbCrLf  GoTo Finally End Sub

User · Answer

Please look into Von Pookie s answer  all credits to him her     Sub asdf   Dim ws As Worksheet  newWb As Workbook  Application ScreenUpdating   False For Each ws In Sheets Array  EID Upload    Wages with Locals Upload    Wages without Local Upload       ws Copy    Set newWb   ActiveWorkbook    With newWb        SaveAs ws Name  xlCSV        Close  False     End With Next ws Application ScreenUpdating   True  End Sub

User · Answer

Building on Graham s answer  the extra code saves the workbook back into it s original location in it s original format   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    C           For Each WS In ThisWorkbook Worksheets           WS SaveAs SaveToDirectory  amp  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

[excel] Save each sheet in a workbook to separate CSV files

Examples related to excel

Examples related to vba

Examples related to csv