複製工作表時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 

這似乎只發生在我多次使用它之後，它可能會擅長不正確關閉？

Answer 1

由於似乎沒有出現錯誤的模式，我的猜測是錯誤源於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錯誤。如果你找出解決方案，請發佈它;我很好奇你是如何解決問題的。

Answer 2

如果錯誤位於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