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

Question

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

到目前为止，代码有效，但只有一部分时间，其余时间它告诉我workbooks("Name").Sheet(i)下标超出范围。 错误似乎没有模式

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("Appendix 3 V0_00.xls")因为当我使用with它更频繁地抛出相同的错误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 没有正确关闭吗？

Answer 1

如果错误出现在WS.Copy After:=Workbooks("Appendix 3 V0_00.xls").Sheets(i) ，我建议您创建一个新的 Workbook 变量。

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

Answer 2

由于您收到的错误似乎没有模式，我的猜测是错误源于Sheets(i)而不是from Workbooks("Appendix 3 V0_00.xls")因为您没有选择特定的从wbSource选择工作表的wbSource 。 老实说，我真的看不出你的代码有什么问题，但不是

For Each WS in wbSource.Worksheets

尝试

For j = 1 To wbSource.Worksheets.Count

用Sheets(j)替换每个WS 。 从技术上讲，这应该没有太大区别，但我已经通过对我的代码进行看似无用的调整多次摆脱了 VBA 错误。 如果您找到解决方案，请发布； 我很好奇你是如何解决这个问题的。