Save each sheet in a workbook to separate CSV files

@AlexDuggleby: you don't need to copy the worksheets, you can save them directly. e.g.:

Public Sub SaveWorksheetsAsCsv()Dim WS As Excel.WorksheetDim SaveToDirectory As String    SaveToDirectory = "C:\"    For Each WS In ThisWorkbook.Worksheets        WS.SaveAs SaveToDirectory & WS.Name, xlCSV    NextEnd 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.

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 capabilitiesPrivate 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 LongEnd TypePrivate Declare Function SHGetPathFromIDList Lib "shell32.dll" _                                             Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As LongPrivate Declare Function SHBrowseForFolder Lib "shell32.dll" _                                           Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongFunction 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&    ' 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 = &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 IfEnd 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 & "\" & _             wsSheet.Name & ".csv" For Output As #nFileNum        ExportToTextFile CStr(nFileNum), Sep, False        Close nFileNum    Next wsSheetEnd SubPublic 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 & CellValue & Sep        Next ColNdx        WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))        Print #nFileNum, WholeLine    Next RowNdxEndMacro:    On Error GoTo 0    Application.ScreenUpdating = TrueEnd Sub

And here's my solution should work with Excel > 2000, but tested only on 2007:

Private Sub SaveAllSheetsAsCSV()On Error GoTo Heaven' each sheet referenceDim Sheet As Worksheet' path to output toDim OutputPath As String' name of each csvDim OutputFile As StringApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseApplication.EnableEvents = False' ask the user where to saveOutputPath = InputBox("Enter a directory to save to", "Save to directory", Path)If OutputPath <> "" Then    ' save for each sheet    For Each Sheet In Sheets        OutputFile = OutputPath & "\" & 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    NextEnd IfFinally:Application.ScreenUpdating = TrueApplication.DisplayAlerts = TrueApplication.EnableEvents = TrueExit SubHeaven:MsgBox "Couldn't save all sheets to CSV." & vbCrLf & _        "Source: " & Err.Source & " " & vbCrLf & _        "Number: " & Err.Number & " " & vbCrLf & _        "Description: " & Err.Description & " " & vbCrLfGoTo FinallyEnd Sub

(OT: I wonder if SO will replace some of my minor blogging)