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

目的：

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

条件：

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

我发现VBA代码让我的目标达到了一半。 它将所有工作表保存在工作簿中，但文件名与当前date不是dynamic的。

当前代码：

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 

Answer 1

你的代码有几个问题：

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

ii）您正在复制书中的每个工作表，但不能复制到任何地方。 此代码实际上是保存与每个工作表的名称相同的工作簿。 复制工作表不会将其粘贴到任何地方，也不会仅仅使用文档的某些部分来告诉保存function。

iii）把date放在名字里，你只需要把它附加到保存名称string中，如下所示。

  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 

Answer 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