如何使用 VBA 从工作簿中保存特定工作表？答案

【问题标题】：How to save Specific worksheets from a workbook using VBA?如何使用 VBA 从工作簿中保存特定工作表？
【发布时间】：2015-06-09 19:55:49
【问题描述】：

目标：

将工作簿中的特定工作表保存为唯一的 CSV 文件

条件：

从包含特定工作表和无关工作表的工作簿中保存特定工作表（复数）（例如，保存 20 个可用工作表中的特定 10 个）
将当前日期插入 CSV 的文件名，以避免覆盖当前保存文件夹中的文件（此 VBA 每天运行）
文件名语法：CurrentDate_WorksheetName.csv

我发现 VBA 代码可以帮助我实现目标。它将所有工作表保存在工作簿中，但文件名不是与当前日期动态的。

当前代码：

Private Sub SaveWorksheetsAsCsv()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim DateToday As Range


Dim CurrentWorkbook As String
Dim CurrentFormat As Long


CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "S:\test\"
For Each WS In ThisWorkbook.Worksheets
    Sheets(WS.Name).Copy
    ActiveWorkbook.SaveAs Filename:=SaveToDirectory & WS.Name & ".csv", FileFormat:=xlCSV
    ActiveWorkbook.Close savechanges:=False
    ThisWorkbook.Activate
Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub

【问题讨论】：

您如何决定要保存哪些工作表？保存工作表“For each ws in....”的循环正在保存每个工作表，而不是检查工作表的名称或其他任何内容......
我投票结束这个问题，因为它看起来像一个课堂作业。
@Shiva 家庭作业问题本身不会自动偏离主题。话虽这么说，帮助中心确实指定“要求家庭作业帮助的问题必须包括您迄今为止为解决问题所做的工作的摘要，以及您解决问题的困难的描述”和这个问题肯定可以更好地说明所讨论的“特定问题或错误”。
@hopper 是的，完全正确。请注意问题是“我找到了 VBA 代码”。翻译 = OP 没有做出任何努力来解决它。

标签： vba excel csv

【解决方案1】：

您的代码有几个问题：

i) 没有理由保存当前工作簿的格式或名称。只需使用新工作簿来保存所需的 CSV。

ii) 您复制了书中的每个工作表，但没有复制到任何地方。此代码实际上是使用每个工作表的名称保存同一个工作簿。复制工作表不会将其粘贴到任何地方，实际上并不会告诉保存函数仅使用文档的一部分。

iii) 要将日期放入名称中，只需将其附加到保存名称字符串中，如下所示。

 Dim myWorksheets() As String 'Array to hold worksheet names to copy
 Dim newWB As Workbook
 Dim CurrWB As Workbook
 Dim i As Integer


 Set CurrWB = ThisWorkbook

 SaveToDirectory = "S:\test\"


 myWorksheets = Split("SheetName1, SheetName2, SheetName3", ",")
 'this contains an array of the sheets.  
 'If you want more, put another comma and then the next sheet name.
 'You need to put the real sheet names here.

 For i = LBound(myWorksheets) To UBound(myWorksheets) 'Go through entire array

      Set newWB = Workbooks.Add 'Create new workbook

      CurrWB.Sheets(Trim(myWorksheets(i))).Copy Before:=newWB.Sheets(1)
      'Copy worksheet to new workbook
      newWB.SaveAs Filename:=SaveToDirectory & Format(Date, "yyyymmdd") & myWorksheets(i), FileFormat:=xlCSV
      'Save new workbook in csv format to requested directory including date.
      newWB.Close saveChanges:=False 
      'Close new workbook without saving (it is already saved)

 Next i

 CurrWB.Save 'save original workbook.

 End Sub

【讨论】：

谢谢 OpiesDad，但我还是遇到了一个问题。此处代码中断“Set newWB = Workbooks.Add 'Create new workbook”的错误信息
错误消息被截断了......该代码对我有用，所以我不确定问题是什么。但是，您可以尝试使用谷歌搜索错误消息以尝试确定其原因。

【解决方案2】：

在我看来，那段代码中有很多不必要的东西，但最重要的部分几乎准备好了。试试这个：

Sub SaveWorksheetsAsCsv()

Dim WS As Worksheet
Dim SaveToDirectory As String

SaveToDirectory = "C:\tmp\"

Application.DisplayAlerts = False

For Each WS In ThisWorkbook.Worksheets
    WS.SaveAs Filename:=SaveToDirectory & Format(Now(), "yyyymmdd") & "_" & WS.Name & ".csv", FileFormat:=xlCSV
Next

Application.DisplayAlerts = True

End Sub

【讨论】：