Question

我有一个生成多个电子表格的宏。我想将这些电子表格复制到新工作簿，在我去的时候重命名工作表，并使用新名称保存工作簿。

我尝试使用以下代码，但它会生成运行时错误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

自己测试代码之后就是问题：

当您执行Set wb = Workbooks.Add Excel时，使用名为Workbook的{{1}}代替Worksheet创建新的Sheet1。

因此，以下代码将解决问题：

Sheet 1

您还需要执行以下操作：

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

Application.SheetsInNewWorkbook = 3 Set wb = Workbooks.Add创建一个Workbooks.Add，其中包含1 Workbook（在我的Excel上），以确保您获得所需的合适数量的工作表，您必须将Sheet设置为需要的金额。（我假设3基于您的代码）

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

1 个答案: