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

时间:2015-06-09 19:55:49

标签: excel vba excel-vba csv

目的:

  1. 将工作簿中的特定工作表另存为唯一的CSV文件
  2. 条件:

    1. 从包含特定工作表和无关工作表的工作簿中保存特定工作表(复数)(例如,保存20个可用工作表中的特定工作表)
    2. 将当前日期插入CSV的文件名中,以避免覆盖当前保存文件夹中的文件(此VBA每天运行)
    3. 文件名语法:CurrentDate_WorksheetName.csv
    4. 我发现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
      

2 个答案:

答案 0 :(得分:0)

您的代码存在以下问题:

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

答案 1 :(得分:0)

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

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