复制工作表时VBA错误“9”下标超出范围

我目前正在尝试创建一个代码，该代码将从大量工作簿中获取所有工作表，并将它们粘贴到预先选择的工作簿中

到目前为止，代码仍然有效，但只有部分时间，其余时间它告诉我WorkbookName.Sheeti下标超出范围。这个错误似乎没有规律可循

If Not UserForm1.filePath = "" Then
    Dim db As DAO.Database
    Set db = OpenDatabase(UserForm1.filePath)
    Dim rst As DAO.Recordset
    Set rst = db.OpenRecordset("tIO")
    Dim Filename As String
    Dim WS As Worksheet
    Dim Counter As Integer
    Dim i As Integer
    i = 1
        While Not rst.EOF
            If Not Filename = rst!Filename Then
                Filename = rst!Filename
                Dim wbSource As Workbook
                Set wbSource = Workbooks.Open(Filename:=Filename)

                Counter = Counter + 1
                'Loop through all of the worksheets in the Active workbook
                For Each WS In wbSource.Worksheets
                    WS.Activate
                    WS.Select
                    WS.Name = (WS.Name & "_" & Counter)
                    WS.Activate
                    WS.Select
                    WS.Copy After:=Workbooks("Appendix 3 V0_00.xls").Sheets(i)
                    i = i + 1
                Next
                wbSource.Close False
            End If
            rst.MoveNext
        Wend
End If

我写了Workbooks附录3 V0_00.xls，因为当我使用with时，它会更频繁地抛出相同的错误，所以现在看起来是这样的

If Not UserForm1.filePath = "" Then
    Dim db As DAO.Database
    Set db = OpenDatabase(UserForm1.filePath)
    Dim rst As DAO.Recordset
    Set rst = db.OpenRecordset("tIO")
    Dim Filename As String
    Dim WS As Worksheet
    Dim Counter As Integer
    Dim j As Integer
    While Not rst.EOF
        If Not Filename = rst!Filename Then
            Filename = rst!Filename
            Dim wbSource As Workbook
            If Dir(Filename) <> "" Then
                Set wbSource = Workbooks.Open(Filename:=Filename)
                Counter = Counter + 1
                'Loop through all of the worksheets in the Active workbook
                For j = 1 To wbSource.Worksheets.Count
                    wbSource.Sheets(j).Activate
                    wbSource.Sheets(j).Select
                    wbSource.Sheets(j).Name = (wbSource.Sheets(j).Name & "_" & Counter)
                    wbSource.Sheets(j).Activate
                    wbSource.Sheets(j).Select
                    wbSource.Sheets(j).Copy After:=Workbooks("Appendix 3 V0_00.xls").Sheets(Workbooks("Appendix 3 V0_00.xls").Sheets.Count)
                Next
                wbSource.Close False
            End If
        End If
        rst.MoveNext
    Wend


End If
wb.SaveAs (Module1.AppendicesFolder & "\" & UserForm1.TxtJobNumber & " " & UserForm1.TxtJobName & " Appendix3 V0.00.xls")
wb.Close

xlApp.Quit
End Sub

这似乎只有在我多次使用它之后才会发生，它可能是excel未正确关闭吗？

如果错误发生在WS.Copy after:=Workbooks附录3 V0_00.xls.Sheetsi上，我建议您创建一个新的工作簿变量

Dim Wb As WorkBook
Set Wb = Workbooks("Appendix 3 V0_00.xls")

然后将其用于复制行：

WS.Copy After:=Wb.Sheets(Wb.Sheets.Count)

或者按照@Jeeped的建议，您可以简单地使用With语句：

With Workbooks("Appendix 3 V0_00.xls")
    If Not UserForm1.filePath = "" Then
        Dim db As DAO.Database
        Set db = OpenDatabase(UserForm1.filePath)
        Dim rst As DAO.Recordset
        Set rst = db.OpenRecordset("tIO")
        Dim Filename As String
        Dim WS As Worksheet
        Dim Counter As Integer
        Dim i As Integer
        i = 1
            While Not rst.EOF
                If Not Filename = rst!Filename Then
                    Filename = rst!Filename
                    Dim wbSource As Workbook
                    Set wbSource = Workbooks.Open(Filename:=Filename)

                    Counter = Counter + 1
                    'Loop through all of the worksheets in the Active workbook
                    For Each WS In wbSource.Worksheets
                        WS.Activate
                        WS.Select
                        WS.Name = (WS.Name & "_" & Counter)
                        WS.Activate
                        WS.Select
                        WS.Copy After:= .Sheets(.Sheets.Count)
                        i = i + 1
                    Next
                    wbSource.Close False
                End If
                rst.MoveNext
            Wend
    End If
End With

---

由于您得到的错误似乎没有模式，我猜错误源于Sheets，而不是Workbooks附录3 V0_00.xls，因为您没有选择从wbSource选择工作表的特定顺序。老实说，我真的看不出您的代码中有什么错误，但是

For Each WS in wbSource.Worksheets

试一试

---

将每个WS更换为Sheetsj。从技术上讲，这应该没有多大区别，但是我已经多次通过对代码进行看似无用的调整来消除VBA错误。如果你想出了解决办法，请把它贴出来；我很想知道你是如何解决这个问题的

您的意思是错误在这一行WS.Copy After:=Workbooks附录3 V0_00.xls.Sheetsi？也许带有Workbooks附录3 V0_00.xls的a可以避免在完成相同任务时设置新的var。。。？WS独立于任何父引用。@Jeeped:Thx仅供参考，确实不需要使用变量，但这是一个习惯问题，我通常喜欢在代码开始时定义所有变量，以便将所有硬编码参数放在一个位置。我已经设置了wb=Workbooks附录3 V0_00.xls。愚蠢的是，我忘了插入它。with有效，但当我尝试使用wb.sheetswb.sheets.count时，我不认为这是因为在代码之前，我有：Dim xlApp as Excel.Application Set xlApp=New Excel.Application Dim wb as Excel.Workbook Set wb=xlApp.Workbooks.OpenL:\SI\Appendix 3 V0_00.xln它仍然出现

For j = 1 To wbSource.Worksheets.Count