I recently went on a hunt to try to figure out a way to export all my worksheets in an Excel document to CSV. The need arose simply out of frustration. Instead of copying cells and pasting as values into a new workbook, then saving as CSV, I wanted a simple and logical approach that could save me time and frustration.
Well, luckily a couple of folks hijacked an Excel thread and provided a simple Macro that can do the job quickly and easily. Unfortunately, the original Macro dumped everything into the folder the Excel Workbook resided in. With a small modification, it now exports all CSV files into a sub-directory “CSV”.
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 Dim strDir As String strDir = OutputPath & "\CSV\" If Dir(strDir, vbDirectory) = "" Then MkDir strDir Else End If If OutputPath <> "" Then Application.Calculation = xlCalculationManual ' save for each sheet For Each Sheet In Sheets OutputFile = OutputPath & "\CSV\" & Application.PathSeparator & Sheet.Name & ".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." & vbCrLf & _ "Source: " & Err.Source & " " & vbCrLf & _ "Number: " & Err.Number & " " & vbCrLf & _ "Description: " & Err.Description & " " & vbCrLf GoTo Finally End Sub
Credit to Alex, Graham, and Vivek for the original Macro