代码中的下标超出范围错误

Question

我有一个宏，可以按组将数据从主工作表移动到工作簿中的相应工作表，然后为每个工作表创建一个单独的工作簿......但我遇到了一个错误，不记得有改变了它的任何东西。有人可以告诉我出了什么问题以及如何解决吗？

以 Activeworkbook.SaveAs 开头的行中的下标超出范围错误...

Sub transfer_data()
Application.ScreenUpdating = False
Dim filter_criteria As String
Dim bridge_rows As Integer
Dim rng As Range
Dim rng2 As Range
Dim dest_num_rows As Integer
bridge_rows = Worksheets("Bridge").Range("A1").CurrentRegion.Rows.Count
Set rng = Worksheets("Master").Range("A6").CurrentRegion
For n = 3 To bridge_rows + 1
    filter_criteria = Application.WorksheetFunction.Index(Worksheets("Bridge").Range("A1:B" & bridge_rows), Application.WorksheetFunction.Match(Worksheets(n).Name, Worksheets("Bridge").Range("B1:B" & bridge_rows), 0), 1)
    dest_num_rows = Worksheets(n).Range("A1").CurrentRegion.Rows.Count
    rng.AutoFilter Field:=7, Criteria1:=filter_criteria
    Set rng2 = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, 6)
    rng2.Copy Destination:=Worksheets(n).Range("A" & dest_num_rows + 1)
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:="H:\BX-HR\BX-INDUSTRIAL RELATIONS\HR REPRESENTATIVES\PRIVATE\HRSSC\US&CA Benefits\Data Files\" & Workbooks("Retroactive Premiums - Semi-monthly v2.xlsm").Worksheets(n).Name, FileFormat:=xlCSV, CreateBackup:=False
    ThisWorkbook.Sheets(n).Range("A1").CurrentRegion.Copy Destination:=ActiveWorkbook.Worksheets(1).Range("A1")
    ActiveWorkbook.Close savechanges:=True
Next n
rng.AutoFilter
Worksheets("Master").Range("A7:A" & rng.Rows.Count + 5).Clear
Worksheets("Master").Range("D7:D" & rng.Rows.Count + 5).Clear
Application.ScreenUpdating = True
End Sub

Answer 1

您的错误必须与给您错误的行的这一部分有关：

Workbooks("Retroactive Premiums - Semi-monthly v2.xlsm").Worksheets(n)

出现错误的原因有两个：

1. Workbooks("Retroactive Premiums - Semi-monthly v2.xlsm"): 具有指定名称的工作簿当前未打开。
2. Worksheets(n)：具有该名称的指定工作簿已打开，但没有带有 n 索引的工作表。

Answer 2

这是应该声明变量/对象并使用它们的主要原因之一 :) 应避免使用 Activeworkbook/Select 等内容。

你应该使用这样的代码

Sub Sample()
    Dim wbThis As Workbook, wbNew As Workbook
    Dim sPath As String

    sPath = "H:\BX-HR\BX-INDUSTRIAL RELATIONS\HR REPRESENTATIVES\PRIVATE\HRSSC\US&CA Benefits\Data Files\"

    Set wbThis = ThisWorkbook '<~~ "Retroactive Premiums - Semi-monthly v2.xlsm" ???

    '
    '~~> Rest of the code
    '

    Set wbNew = Workbooks.Add

    wbNew.SaveAs Filename:=sPath & wbThis.Worksheets(n).Name, FileFormat:=xlCSV, CreateBackup:=False

    '
    '~~> Rest of the code
    '
End Sub