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

我有一个macros，将数据从一个主表单移动到工作簿中各自的工作表中，然后为每个工作表创build一个单独的工作簿…但是我一直收到一个错误，不记得有任何改变它。 有人可以让我知道什么是错的，以及如何解决它？

下标超出范围的错误行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

这是为什么应该声明variables/对象并使用它们的一个主要原因:)应该避免像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