Question

我一直在使用下面的代码为我的工作簿中的每个工作表成功创建并保存新工作簿。当我尝试运行它时，我收到错误“编译错误参数数量或属性分配无效”。我不明白为什么它现在不起作用;它之前做过。我确实想要最终名称中的日期。如果我使用标有'wb.SaveAs行的代码运行代码，那就可以了。它现在似乎不喜欢格式部分。任何想法有什么不同，为什么？感谢信。

Sub Make_Workbooks()

Dim ws As Worksheet
Dim wb As Workbook


  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

For Each ws In ThisWorkbook.Worksheets

Set wb = Workbooks.Add
'wb.SaveAs ThisWorkbook.Path & "\" & ws.Name
wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd") & ".xlsx"
ws.Copy Before:=wb.Worksheets(1)
wb.Close SaveChanges:=True

Next ws

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Answer 1

我无法在我的系统上复制您的问题，但以下代码最大限度地减少了新Workbook对象的显式创建和跟踪，因此在不同环境中可能不太容易出错：

Sub Make_Workbooks()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    ws.Copy     'Copies current sheet to new workbook
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ws.Name & "_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
    ActiveWindow.Close
Next ws

End Sub

Answer 2

用于SaveAs的语法应为 FileName ， FileFormat ，.. ..

在您的代码中应该是：

wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd"), xlOpenXMLWorkbook

（xlOpenXMLWorkbook =“。xlsx”）

如果您每天都会运行几次代码，那么如果您要覆盖现有文件，则会收到一条消息，因为ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd")会在同一天拥有相同的String。

如果您想自动覆盖以前的文件，请添加第Application.DisplayAlerts = False行。

<强>代码

Option Explicit

Sub Make_Workbooks()

Dim ws As Worksheet
Dim wb As Workbook

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For Each ws In ThisWorkbook.Worksheets
    Set wb = Workbooks.Add
    ' add this line to automatically overwrite the exisitng file (not getting the MsgBox on every time)
    Application.DisplayAlerts = False
    wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd"), xlOpenXMLWorkbook
    ws.Copy Before:=wb.Worksheets(1)
    wb.Close SaveChanges:=True
Next ws

ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Edit1 ：如果您想确保2个文件名永远不会有相同名称，可以使用Now函数：

wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Now, "yyyy-mm-dd_hh_mm_ss"), xlOpenXMLWorkbook

保存工作簿时出现新的Excel VBA编译错误

2 个答案: