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

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