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

似乎只有在我多次使用它之后才会发生这种情况会不会不能正常关闭？

Answer 1

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

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选择工作表的特定顺序。说实话，我无法真正看到代码中出现的问题，而不是

For Each WS in wbSource.Worksheets

试

For j = 1 To wbSource.Worksheets.Count

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

VBA错误＆＃39; 9＆＃39;复制工作表时，下标超出范围

2 个答案: