错误处理程序在vba中只工作一次

我试图从几个具有不同工作表名称的工作簿中提取数据。我创建了一个数组，其中包含所有可能的图纸名称。当数据工作簿打开且找不到工作表名称时，当循环再次运行并提取下一个数组元素时，错误处理程序第一次工作，错误处理程序不工作。它给出了“下标超出范围”错误。有人能详细说明我在这里遗漏了什么吗？我想要的是，若连续的工作表名称在数据工作簿中不可用，代码应该再次进入for循环并搜索下一个工作表名称

Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook

Sub GetData()
    Dim strListSheet As String
    Dim i As Integer
    Dim VendorValue As String
    Dim SheetNames() As Variant
    Dim a As String

    strListSheet = "Master"

    Sheets(strListSheet).Select
    Range("First_file").Select
    SheetNames = Range("Sheet_Names")

    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
    Set currentWB = ActiveWorkbook
    Do While ActiveCell.Value <> ""

        strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
        VendorValue = ActiveCell.Offset(0, 2)
        Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
        Set dataWB = ActiveWorkbook

        For i = LBound(SheetNames, 1) To UBound(SheetNames, 1)
        a = SheetNames(i, 1)
        b = SheetNames(i, 2)

        dataWB.Activate
        On Error GoTo Handler:
        ActiveWorkbook.Sheets(a).Select

        Range("H5:H120,I5:I120,M5:M120,P5:P120,U5:X120").Select
        Selection.Copy

        currentWB.Activate
        Sheets(VendorValue).Select
        Range(b).Select

        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False

Handler:
        Next  
        dataWB.Close False
        Sheets(strListSheet).Select
        ActiveCell.Offset(1, 0).Select

    Loop

    Exit Sub
End Sub

Public strFileName作为字符串
Public currentWB As工作簿
公共数据WB作为工作簿
子GetData（）
将strlist表设置为字符串
作为整数的Dim i
Dim VendorValue作为字符串
Dim SheetNames（）作为变量
像线一样变暗
strListSheet=“Master”
工作表（strListSheet）。选择
范围（“第一个文件”）。选择
图纸名称=范围（“图纸名称”）
这是主循环，我们将逐个打开文件，并将其数据复制到主数据表中
设置currentWB=ActiveWorkbook
当ActiveCell.Value“”时执行此操作
strFileName=ActiveCell.Offset（0，1）&ActiveCell.Value
VendorValue=ActiveCell.Offset（0,2）
Application.Workbooks.Open strFileName，UpdateLinks:=False，ReadOnly:=True
设置dataWB=ActiveWorkbook
对于i=LBound（SheetNames，1）到UBound（SheetNames，1）
a=图纸名称（i，1）
b=图纸名称（i，2）
dataWB.Activate
错误转到处理程序时：
ActiveWorkbook.Sheets（a）。选择
范围（“H5:H120，I5:I120，M5:M120，P5:P120，U5:X120”）。选择
选择，复制
当前wb.Activate
工作表（VendorValue）。选择
范围（b）。选择
Selection.PasteSpecial xlPasteValues、XLPasteSpecialLoperationNone
Application.CutCopyMode=False
处理程序：
下一个
dataWB.Close为False
工作表（strListSheet）。选择
ActiveCell.Offset（1，0）。选择
环
出口接头
端接头

您必须退出错误处理程序才能重新使用它。也就是说，在错误处理程序的末尾需要一个

Resume

子句

查看此项了解更多详细信息

我已经移动了子文件末尾的处理程序，并添加了一个

Resume

Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook

Sub GetData()
    Dim strListSheet As String
    Dim i As Integer
    Dim VendorValue As String
    Dim SheetNames() As Variant
    Dim a As String

    strListSheet = "Master"

    Sheets(strListSheet).Select
    Range("First_file").Select
    SheetNames = Range("Sheet_Names")

    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
    Set currentWB = ActiveWorkbook
    Do While ActiveCell.Value <> ""

        strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
        VendorValue = ActiveCell.Offset(0, 2)
        Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
        Set dataWB = ActiveWorkbook

        For i = LBound(SheetNames, 1) To UBound(SheetNames, 1)
        a = SheetNames(i, 1)
        b = SheetNames(i, 2)

        dataWB.Activate
        On Error GoTo Handler:
        ActiveWorkbook.Sheets(a).Select

        Range("H5:H120,I5:I120,M5:M120,P5:P120,U5:X120").Select
        Selection.Copy

        currentWB.Activate
        Sheets(VendorValue).Select
        Range(b).Select

        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False

Handler2:
        Next  
        dataWB.Close False
        Sheets(strListSheet).Select
        ActiveCell.Offset(1, 0).Select

    Loop

    Exit Sub
Handler:
    Resume Handler2
End Sub

Public strFileName作为字符串
Public currentWB As工作簿
公共数据WB作为工作簿
子GetData（）
将strlist表设置为字符串
作为整数的Dim i
Dim VendorValue作为字符串
Dim SheetNames（）作为变量
像线一样变暗
strListSheet=“Master”
工作表（strListSheet）。选择
范围（“第一个文件”）。选择
图纸名称=范围（“图纸名称”）
这是主循环，我们将逐个打开文件，并将其数据复制到主数据表中
设置currentWB=ActiveWorkbook
当ActiveCell.Value“”时执行此操作
strFileName=ActiveCell.Offset（0，1）&ActiveCell.Value
VendorValue=ActiveCell.Offset（0,2）
Application.Workbooks.Open strFileName，UpdateLinks:=False，ReadOnly:=True
设置dataWB=ActiveWorkbook
对于i=LBound（SheetNames，1）到UBound（SheetNames，1）
a=图纸名称（i，1）
b=图纸名称（i，2）
dataWB.Activate
错误转到处理程序时：
ActiveWorkbook.Sheets（a）。选择
范围（“H5:H120，I5:I120，M5:M120，P5:P120，U5:X120”）。选择
选择，复制
当前wb.Activate
工作表（VendorValue）。选择
范围（b）。选择
Selection.PasteSpecial xlPasteValues、XLPasteSpecialLoperationNone
Application.CutCopyMode=False
Handler2：
下一个
dataWB.Close为False
工作表（strListSheet）。选择
ActiveCell.Offset（1，0）。选择
环
出口接头
处理程序：
简历管理员2
端接头

如果您的所有文件都位于同一路径中，我认为使用该路径更容易：

Sub openOtherWorkbooks()

    Dim folderPath As String, path As String

    folderPath = "C:\Path\to\your\files"

    path = folderPath & "\*.xlsm"        'xlsm as an example - could be xls* as well

    Do While Filename <> ""

        Filename = Dir()

        If Filename <> ThisWorkbook.Name And Filename <> "" Then

            Workbooks.Open folderPath & "\" & Filename

            For i = 1 To Workbooks(Filename).Sheets.count

                ' do everything with every sheet of this file

            Next i

            Workbooks(Filename).Close False

        End If

        Filename = Dir(path)

    Loop

End Sub

子打开其他工作簿（）
将文件夹路径设置为字符串，路径设置为字符串
folderPath=“C:\Path\to\your\files”
path=folderPath&“\*.xlsm”xlsm作为示例-也可以是xls*
文件名“”时执行此操作
Filename=Dir（）
如果文件名为ThisWorkbook.Name和文件名为“”，则
工作簿。打开文件夹路径和“\”文件名
对于i=1到工作簿（文件名）.Sheets.count
'使用此文件的每一页执行所有操作
接下来我
工作簿（文件名）。关闭False
如果结束
Filename=Dir（路径）
环
端接头

它只是打开每个文件，计算打开文件的工作表（从1开始），然后应该有您的代码

---

这不完全是对你的错误的回答，你和你的处理程序一起去做

我将改变方法如下：

Dim mySht as Worksheet 

a = SheetNames(i, 1)
Set mySht = GetSheet(dataWB, a)
If Not mySht Is Nothing Then
   b = SheetNames(i, 2)
   With mySht
      .Range("H5:H120,I5:I120,M5:M120,P5:P120,U5:X120").Copy
      currentWB.Sheets(VendorValue).Range(b).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False
   End With  
End If

其中我只显示了从

a

和

b

设置（包括）到

处理程序标签（包括，即它必须消失）的部分

您必须将此代码放在任何模块中（也可以放在子模块末尾）：

最后，剩下的代码可以以类似的方式避免大量的Activate/Active/Select/Selection内容
@eeeklavya:你完成了吗？是的，thanxxx，我已经用resume语句重置了错误处理程序。我也会尝试这种方法…很好。我总是发现它更健壮，更容易阅读和维护代码，而不依赖于错误GoTo上的
语句。如果你觉得这个答案有用的话，你可以投票支持它。谢谢注意，您的代码还有改进的余地，例如删除
。例如，选择
。看见
Function GetSheet(wb as Workbook, shtName as String)
   On Error Resume Next
   Set GetSheet = wb.Worksheet(shtName)
End Function