CODEWITHSUNDEEP
excelvba
Regina
Regina

Reputation: 11

Export multiple worksheets to CSV files in a specified directory

I'm trying to do the following:

  1. Export/Copy particular sheets in the workbook (any sheet name that contains "Upload") to a particular file directory.
  2. I don't want these worksheet names to change nor the workbook name to change.
  3. The file-name is consistent for each worksheet, so it would be okay to replace the files in the directory whenever I run the macro. It is okay to have a dialog box that asks if I'm sure I want to replace each of the files.
  4. I don't want the newly created CSVs or any other file to open. 
Sub SheetsToCSV() 

    'Jerry Beaucaire (1/25/2010), updated (8/15/2015)  
    'Save each sheet to an individual CSV file  
    Dim ws As Worksheet, fPATH As String

    Application.ScreenUpdating = False      'speed up macro  
    Application.DisplayAlerts = False       'automatically overwrite old files  
    fPATH = "C:\2015\CSV\"                  'path to save into, remember the final \ in this string  

    For Each ws In Worksheets
        ws.Copy
        ActiveWorkbook.SaveAs Filename:=fPATH & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close
    Next ws

    Application.ScreenUpdating = True  
End Sub

Upvotes: 1

Views: 1931

Answers (1)

joehanna
joehanna

Reputation: 1489

You just need to add a simple loop through all worksheets and test the name.

Try this:-

Sub COPYSelectedSheetsToCSV()

  Dim ws As Worksheet

  'In case something goes wrong      
  On Error GoTo COPYSelectedSheetsToCSVZ

  'Loop through all worksheets
  For Each ws In ActiveWorkbook.Sheets

    'Does the name contain "Upload" 
    If InStr(1, ws.Name, "Upload") > 0 Then

      'Make the worksheet active
      ws.Select

      'Save it to CSV
      ActiveWorkbook.SaveAs Filename:="/Users/reginaho/Desktop/Upload/" & ws.Name & ".csv", _
          FileFormat:=xlCSV, CreateBackup:=False

    End If

  Next

COPYSelectedSheetsToCSVX:

  'Clean up the memory usage
  Set ws = Nothing

  Exit Sub

COPYSelectedSheetsToCSVZ:
  MsgBox Err.Number & " - " & Err.Description
  Resume COPYSelectedSheetsToCSVX

End Sub

Upvotes: 1

Related Questions