复制工作表时 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 时，它更频繁地抛出相同的错误所以现在看起来像这样；

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