将多个工作表导出到指定目录中的 CSV 文件答案

【问题标题】：Export multiple worksheets to CSV files in a specified directory将多个工作表导出到指定目录中的 CSV 文件
【发布时间】：2019-12-02 11:51:18
【问题描述】：

我正在尝试执行以下操作：

将工作簿中的特定工作表（包含“上传”的任何工作表名称）导出/复制到特定文件目录。
我不希望更改这些工作表名称，也不希望更改工作簿名称。
每个工作表的文件名都是一致的，所以每当我运行宏时都可以替换目录中的文件。可以有一个对话框询问我是否确定要替换每个文件。
我不希望打开新创建的 CSV 或任何其他文件。

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

【问题讨论】：

标签： excel vba

【解决方案1】：

您只需在所有工作表中添加一个简单的循环并测试名称。

试试这个：-

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

【讨论】：