如何将多个电子表格复制到新的工作簿？

我有一个生成多个电子表格的macros。 我想将这些电子表格复制到一个新的工作簿中，重新命名这些工作表，并以新名称保存工作簿。

我试图使用下面的代码，但它会生成运行时错误9，下标超出范围

Dim z As Variant Dim wb As Workbook Worksheets("T_Summary").Activate Set wb = Workbooks.Add z = Format(DateTime.Now, "dd-MM-YYYY hhmm") wb.SaveAs "C\...\desktop\Transactions Summary " & z & ".xlsx" Workbooks("Transactions Summary " & z & ".xlsx").Worksheets("Sheet 1").Range("A1:BO" & h).Value _ = Workbooks("Auto Recon 2.xlsx").Worksheets("TSummary").Range("A1:BO" & h).Value Workbooks("Transactions Summary " & z & ".xlsx").Worksheets("Sheet1").Name = "TSummary" Workbooks("Transactions Summary " & z & ".xlsx").Worksheets("Sheet 2").Range("A1:BO" & h).Value _ = Workbooks("Auto Recon 2.xlsx").Worksheets("Reject").Range("A1:BO" & h).Value Workbooks("Transactions Summary").Worksheets("Sheet1").Name = "Reject" Workbooks("Transactions Summary " & z & ".xlsx").Worksheets("Sheet 3").Range("A1:BO" & h).Value _ = Workbooks("Auto Recon 2.xlsx").Worksheets("U codes").Range("A1:BO" & h).Value Workbooks("Transactions Summary " & z & ".xlsx").Worksheets("Sheet1").Name = "U codes" x = 2 k = Sheets.Count While x <= k Sheets(x).Delete k = Sheets.Count Wend Workbooks("Transactions Summary " & z & ".xlsx").Close savechanges:=True Worksheets("Launch Screen").Activate 

Answer 1

自己testing代码后，这是问题：

当您Set wb = Workbooks.Add Excel使用名为Sheet1而不是Sheet 1的Worksheet一个新的Workbook 。

因此，下面的代码将解决这个问题：

 Workbooks("Transactions Summary " & z & ".xlsx").Worksheets("Sheet1").Range("A1:BO" & h).Value 

您还需要执行以下操作：

 Application.SheetsInNewWorkbook = 3 Set wb = Workbooks.Add 

Workbooks.Add创build一张Workbook （在我的Excel上），以确保您获得所需的表单数量，您将必须设置3所需的金额（我假设3基于您的代码）