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)

这有两个原因导致错误：

Workbooks("Retroactive Premiums - Semi-monthly v2.xlsm")：具有指定名称的工作簿当前未打开。
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

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

2 个答案: