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