Blog‎ > ‎IT‎ > ‎

Save every sheet in an Excel workbook as a CSV file

posted Dec 28, 2013, 1:42 AM by Jake Vosloo   [ updated Dec 28, 2013, 3:05 AM ]
Today I wanted to save every sheet in an Excel workbook as a CSV file, the headings of each sheet is removed first.
Here's the code:

Public Sub SaveAllSheetsAsCSV()
On Error GoTo HandleErr

Dim Sheet As Worksheet
Dim NewWorkbook As Workbook
Dim OutputPath As String
Dim OutputFile As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.CalculateFullRebuild

'Make a folder with the name of the worksheet
OutputPath = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) 'Simple but bad way to remove the extension.
OutputPath = ThisWorkbook.path & Application.PathSeparator & OutputPath
If Dir(OutputPath, vbDirectory) = "" Then
    MkDir OutputPath
End If

For Each Sheet In Sheets
    Set NewWorkbook = Workbooks.Add
    ' Copy contents without headers
    With Sheet.UsedRange
        If .Rows.Count > 1 Then
            .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Copy
        Else
            .Copy
        End If
    End With
    ' Paste values only
    NewWorkbook.Sheets.Item(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValues
    ' Save to CSV file
    OutputFile = OutputPath & Application.PathSeparator & Sheet.Name & ".csv"
    NewWorkbook.SaveAs Filename:=OutputFile, FileFormat:=xlCSV, CreateBackup:=False
    NewWorkbook.Close
Next


Finally:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub

HandleErr:
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


I got help from the following sources:
http://www.mrexcel.com/forum/excel-questions/587522-copy-usedrange-except-header.html
http://stackoverflow.com/questions/59075/save-each-sheet-in-a-workbook-to-separate-csv-files
http://www.excelfox.com/forum/f2/export-all-worksheets-to-separate-csv-files-388/
http://windowssecrets.com/forums/showthread.php/140173-Open-excel-workbook-save-each-worksheet-as-csv-with-tab-name

Comments