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

我目前正在尝试创build一个代码，它将抓取大量工作簿中的所有工作表并将其粘贴到预先选定的工作簿中。

到目前为止，代码工作，但只有一些时间，其余的时间告诉我， 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 

这似乎只发生在我不止一次的使用它之后，它可能会擅长closures不正常？

Answer 1

由于似乎没有错误模式，所以我的猜测是错误源于Sheets(i)而不是from Workbooks("Appendix 3 V0_00.xls")因为您没有select特定的从wbSource中select工作表的wbSource 。 说实话，我不能真正看到你的代码中可能有什么错误，而不是

 For Each WS in wbSource.Worksheets 

尝试

 For j = 1 To wbSource.Worksheets.Count 

用Sheets(j)replace每个WS 。 从技术上说，这应该不会有太大的区别，但是我通过对代码做出看似无用的调整，而多次摆脱了VBA错误。 如果你找出解决scheme，请张贴; 我很好奇，看你是如何解决这个问题的。

Answer 2

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

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

然后你把它用到你的拷贝行中：

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

---

或者像@Jeepedbuild议的那样，您可以简单地使用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