<p>How do I save each sheet in an Excel workbook to separate <code>CSV</code> files with a macro?</p>

<p>I have an excel with multiple sheets and I was looking for a macro that will save each sheet to a separate <code>CSV (comma separated file)</code>. Excel will not allow you to save all sheets to different <code>CSV</code> files.</p>

[{'answer_id': 59078, 'author': 'Alex Duggleby', 'author_id': 5790, 'author_profile': 'https://Stackoverflow.com/users/5790', 'pm_score': 4, 'selected': False, 'text': '<p>And here\'s my solution should work with Excel > 2000, but tested only on 2007:</p>\n\n<pre><code>Private Sub SaveAllSheetsAsCSV()\nOn Error GoTo Heaven\n\n\' each sheet reference\nDim Sheet As Worksheet\n\' path to output to\nDim OutputPath As String\n\' name of each csv\nDim OutputFile As String\n\nApplication.ScreenUpdating = False\nApplication.DisplayAlerts = False\nApplication.EnableEvents = False\n\n\' ask the user where to save\nOutputPath = InputBox("Enter a directory to save to", "Save to directory", Path)\n\nIf OutputPath &lt;&gt; "" Then\n\n    \' save for each sheet\n    For Each Sheet In Sheets\n\n        OutputFile = OutputPath &amp; "\\" &amp; Sheet.Name &amp; ".csv"\n\n        \' make a copy to create a new book with this sheet\n        \' otherwise you will always only get the first sheet\n        Sheet.Copy\n        \' this copy will now become active\n        ActiveWorkbook.SaveAs FileName:=OutputFile, FileFormat:=xlCSV, CreateBackup:=False\n        ActiveWorkbook.Close\n    Next\n\nEnd If\n\nFinally:\nApplication.ScreenUpdating = True\nApplication.DisplayAlerts = True\nApplication.EnableEvents = True\n\nExit Sub\n\nHeaven:\nMsgBox "Couldn\'t save all sheets to CSV." &amp; vbCrLf &amp; _\n        "Source: " &amp; Err.Source &amp; " " &amp; vbCrLf &amp; _\n        "Number: " &amp; Err.Number &amp; " " &amp; vbCrLf &amp; _\n        "Description: " &amp; Err.Description &amp; " " &amp; vbCrLf\n\nGoTo Finally\nEnd Sub\n</code></pre>\n\n<p><em>(OT: I wonder if SO will replace some of my minor blogging)</em></p>\n'}, {'answer_id': 59114, 'author': 'HigherAbstraction', 'author_id': 5945, 'author_profile': 'https://Stackoverflow.com/users/5945', 'pm_score': 7, 'selected': True, 'text': '<p>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):</p>\n\n<pre><code>\' ---------------------- Directory Choosing Helper Functions -----------------------\n\' Excel and VBA do not provide any convenient directory chooser or file chooser\n\' dialogs, but these functions will provide a reference to a system DLL\n\' with the necessary capabilities\nPrivate Type BROWSEINFO    \' used by the function GetFolderName\n    hOwner As Long\n    pidlRoot As Long\n    pszDisplayName As String\n    lpszTitle As String\n    ulFlags As Long\n    lpfn As Long\n    lParam As Long\n    iImage As Long\nEnd Type\n\nPrivate Declare Function SHGetPathFromIDList Lib "shell32.dll" _\n                                             Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long\nPrivate Declare Function SHBrowseForFolder Lib "shell32.dll" _\n                                           Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long\n\nFunction GetFolderName(Msg As String) As String\n    \' returns the name of the folder selected by the user\n    Dim bInfo As BROWSEINFO, path As String, r As Long\n    Dim X As Long, pos As Integer\n    bInfo.pidlRoot = 0&amp;    \' Root folder = Desktop\n    If IsMissing(Msg) Then\n        bInfo.lpszTitle = "Select a folder."\n        \' the dialog title\n    Else\n        bInfo.lpszTitle = Msg    \' the dialog title\n    End If\n    bInfo.ulFlags = &amp;H1    \' Type of directory to return\n    X = SHBrowseForFolder(bInfo)    \' display the dialog\n    \' Parse the result\n    path = Space$(512)\n    r = SHGetPathFromIDList(ByVal X, ByVal path)\n    If r Then\n        pos = InStr(path, Chr$(0))\n        GetFolderName = Left(path, pos - 1)\n    Else\n        GetFolderName = ""\n    End If\nEnd Function\n\'---------------------- END Directory Chooser Helper Functions ----------------------\n\nPublic Sub DoTheExport()\n    Dim FName As Variant\n    Dim Sep As String\n    Dim wsSheet As Worksheet\n    Dim nFileNum As Integer\n    Dim csvPath As String\n\n\n    Sep = InputBox("Enter a single delimiter character (e.g., comma or semi-colon)", _\n                   "Export To Text File")\n    \'csvPath = InputBox("Enter the full path to export CSV files to: ")\n\n    csvPath = GetFolderName("Choose the folder to export CSV files to:")\n    If csvPath = "" Then\n        MsgBox ("You didn\'t choose an export directory. Nothing will be exported.")\n        Exit Sub\n    End If\n\n    For Each wsSheet In Worksheets\n        wsSheet.Activate\n        nFileNum = FreeFile\n        Open csvPath &amp; "\\" &amp; _\n             wsSheet.Name &amp; ".csv" For Output As #nFileNum\n        ExportToTextFile CStr(nFileNum), Sep, False\n        Close nFileNum\n    Next wsSheet\n\nEnd Sub\n\n\n\nPublic Sub ExportToTextFile(nFileNum As Integer, _\n                            Sep As String, SelectionOnly As Boolean)\n\n    Dim WholeLine As String\n    Dim RowNdx As Long\n    Dim ColNdx As Integer\n    Dim StartRow As Long\n    Dim EndRow As Long\n    Dim StartCol As Integer\n    Dim EndCol As Integer\n    Dim CellValue As String\n\n    Application.ScreenUpdating = False\n    On Error GoTo EndMacro:\n\n    If SelectionOnly = True Then\n        With Selection\n            StartRow = .Cells(1).Row\n            StartCol = .Cells(1).Column\n            EndRow = .Cells(.Cells.Count).Row\n            EndCol = .Cells(.Cells.Count).Column\n        End With\n    Else\n        With ActiveSheet.UsedRange\n            StartRow = .Cells(1).Row\n            StartCol = .Cells(1).Column\n            EndRow = .Cells(.Cells.Count).Row\n            EndCol = .Cells(.Cells.Count).Column\n        End With\n    End If\n\n    For RowNdx = StartRow To EndRow\n        WholeLine = ""\n        For ColNdx = StartCol To EndCol\n            If Cells(RowNdx, ColNdx).Value = "" Then\n                CellValue = ""\n            Else\n                CellValue = Cells(RowNdx, ColNdx).Value\n            End If\n            WholeLine = WholeLine &amp; CellValue &amp; Sep\n        Next ColNdx\n        WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))\n        Print #nFileNum, WholeLine\n    Next RowNdx\n\nEndMacro:\n    On Error GoTo 0\n    Application.ScreenUpdating = True\n\nEnd Sub\n</code></pre>\n'}, {'answer_id': 59906, 'author': 'Graham', 'author_id': 1826, 'author_profile': 'https://Stackoverflow.com/users/1826', 'pm_score': 7, 'selected': False, 'text': '<p>@AlexDuggleby: you don\'t need to copy the worksheets, you can save them directly. e.g.:</p>\n\n<pre><code>Public Sub SaveWorksheetsAsCsv()\nDim WS As Excel.Worksheet\nDim SaveToDirectory As String\n\n    SaveToDirectory = "C:\\"\n\n    For Each WS In ThisWorkbook.Worksheets\n        WS.SaveAs SaveToDirectory &amp; WS.Name, xlCSV\n    Next\n\nEnd Sub\n</code></pre>\n\n<p>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.</p>\n'}, {'answer_id': 62301, 'author': 'Robert Mearns', 'author_id': 5050, 'author_profile': 'https://Stackoverflow.com/users/5050', 'pm_score': 4, 'selected': False, 'text': '<p>Building on Graham\'s answer, the extra code saves the workbook back into it\'s original location in it\'s original format.</p>\n\n<pre><code>Public Sub SaveWorksheetsAsCsv()\n\nDim WS As Excel.Worksheet\nDim SaveToDirectory As String\n\nDim CurrentWorkbook As String\nDim CurrentFormat As Long\n\n CurrentWorkbook = ThisWorkbook.FullName\n CurrentFormat = ThisWorkbook.FileFormat\n\' Store current details for the workbook\n\n      SaveToDirectory = "C:\\"\n\n      For Each WS In ThisWorkbook.Worksheets\n          WS.SaveAs SaveToDirectory &amp; WS.Name, xlCSV\n      Next\n\n Application.DisplayAlerts = False\n  ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat\n Application.DisplayAlerts = True\n\' Temporarily turn alerts off to prevent the user being prompted\n\'  about overwriting the original file.\n\nEnd Sub\n</code></pre>\n'}, {'answer_id': 845345, 'author': 'Community', 'author_id': -1, 'author_profile': 'https://Stackoverflow.com/users/-1', 'pm_score': 2, 'selected': False, 'text': '<p>A small modification <a href="https://stackoverflow.com/questions/59075/macro-to-save-each-sheet-in-an-excel-workbook-to-separate-csv-files/59078#59078" title="oh, right here then">to answer from Alex</a> is turning on and off of auto calculation. </p>\n\n<p>Surprisingly the unmodified code was working fine with VLOOKUP but failed with OFFSET. Also turning auto calculation off speeds up the save drastically.</p>\n\n<pre><code>Public Sub SaveAllSheetsAsCSV()\nOn Error GoTo Heaven\n\n\' each sheet reference\nDim Sheet As Worksheet\n\' path to output to\nDim OutputPath As String\n\' name of each csv\nDim OutputFile As String\n\nApplication.ScreenUpdating = False\nApplication.DisplayAlerts = False\nApplication.EnableEvents = False\n\n\' Save the file in current director\nOutputPath = ThisWorkbook.Path\n\n\nIf OutputPath &lt;&gt; "" Then\nApplication.Calculation = xlCalculationManual\n\n\' save for each sheet\nFor Each Sheet In Sheets\n\n    OutputFile = OutputPath &amp; Application.PathSeparator &amp; Sheet.Name &amp; ".csv"\n\n    \' make a copy to create a new book with this sheet\n    \' otherwise you will always only get the first sheet\n\n    Sheet.Copy\n    \' this copy will now become active\n     ActiveWorkbook.SaveAs Filename:=OutputFile, FileFormat:=xlCSV,     CreateBackup:=False\n    ActiveWorkbook.Close\nNext\n\nApplication.Calculation = xlCalculationAutomatic\n\nEnd If\n\nFinally:\nApplication.ScreenUpdating = True\nApplication.DisplayAlerts = True\nApplication.EnableEvents = True\n\nExit Sub\n\nHeaven:\nMsgBox "Couldn\'t save all sheets to CSV." &amp; vbCrLf &amp; _\n        "Source: " &amp; Err.Source &amp; " " &amp; vbCrLf &amp; _\n        "Number: " &amp; Err.Number &amp; " " &amp; vbCrLf &amp; _\n        "Description: " &amp; Err.Description &amp; " " &amp; vbCrLf\n\nGoTo Finally\nEnd Sub\n</code></pre>\n'}, {'answer_id': 27858854, 'author': 'Luigi', 'author_id': 2766120, 'author_profile': 'https://Stackoverflow.com/users/2766120', 'pm_score': 1, 'selected': False, 'text': '<p>Please look into <a href="http://www.mrexcel.com/forum/excel-questions/265154-saving-multiple-sheets-separate-csv-files-visual-basic-applications.html" rel="nofollow">Von Pookie\'s answer</a>, all credits to him/her. </p>\n\n<pre><code> Sub asdf()\nDim ws As Worksheet, newWb As Workbook\n\nApplication.ScreenUpdating = False\nFor Each ws In Sheets(Array("EID Upload", "Wages with Locals Upload", "Wages without Local Upload"))\n   ws.Copy\n   Set newWb = ActiveWorkbook\n   With newWb\n      .SaveAs ws.Name, xlCSV\n      .Close (False)\n   End With\nNext ws\nApplication.ScreenUpdating = True\n\nEnd Sub\n</code></pre>\n'}, {'answer_id': 61893912, 'author': 'Żabojad', 'author_id': 1255091, 'author_profile': 'https://Stackoverflow.com/users/1255091', 'pm_score': 2, 'selected': False, 'text': '<p>For Mac users like me, there are several gotchas:</p>\n\n<p>You cannot save to any directory you want. Only few of them can receive your saved files. More info <a href="https://www.rondebruin.nl/mac/mac034.htm" rel="nofollow noreferrer">there</a></p>\n\n<p>Here is a working script that you can copy paste in your excel for Mac:</p>\n\n<pre><code>Public Sub SaveWorksheetsAsCsv()\n\n Dim WS As Excel.Worksheet\n Dim SaveToDirectory As String\n\n SaveToDirectory = "~/Library/Containers/com.microsoft.Excel/Data/"\n\n For Each WS In ThisWorkbook.Worksheet\n    WS.SaveAs SaveToDirectory &amp; WS.Name &amp; ".csv", xlCSV\n Next\n\nEnd Sub\n\n</code></pre>\n'}, {'answer_id': 66285889, 'author': 'Joshua Pinter', 'author_id': 293280, 'author_profile': 'https://Stackoverflow.com/users/293280', 'pm_score': 2, 'selected': False, 'text': '<h2>Use Visual Basic to loop through worksheets and save <code>.csv</code> files.</h2>\n<ol>\n<li><p>Open up <code>.xlsx</code> file in Excel.</p>\n</li>\n<li><p>Press <kbd>option</kbd>+<kbd>F11</kbd></p>\n</li>\n<li><p><code>Insert</code> → <code>Module</code></p>\n</li>\n<li><p>Insert this into the module code:</p>\n<pre class="lang-vb prettyprint-override"><code>Public Sub SaveWorksheetsAsCsv()\n\n Dim WS As Excel.Worksheet\n Dim SaveToDirectory As String\n\n SaveToDirectory = &quot;./&quot;\n\n For Each WS In ThisWorkbook.Worksheets\n    WS.SaveAs SaveToDirectory &amp; WS.Name &amp; &quot;.csv&quot;, xlCSV\n Next\n\nEnd Sub\n</code></pre>\n</li>\n<li><p>Run the module.</p>\n<p><em>(i.e. Click the play button at the top and then click &quot;Run&quot; on the dialog, if it pops up.)</em></p>\n</li>\n<li><p>Find your <code>.csv</code> files in <code>~/Library/Containers/com.microsoft.Excel/Data</code>.</p>\n<pre class="lang-sh prettyprint-override"><code>open ~/Library/Containers/com.microsoft.Excel/Data\n</code></pre>\n</li>\n<li><p>Close <code>.xlsx</code> file.</p>\n</li>\n<li><p>Rinse and repeat for other <code>.xlsx</code> files.</p>\n</li>\n</ol>\n'}]
['https://Stackoverflow.com/questions/59075', 'https://Stackoverflow.com', 'https://Stackoverflow.com/users/5790/']