[已解决]在线等，数组越界问题！

victory610

我想把test1下的test3工作簿的sheet1工作表的A1：A4单元格区域内容拷贝test3下的test5工作簿的sheet1工作表的A1:A4单元格；
同时把test2下的test4工作簿的sheet1工作表的B1：B4单元格区域内容拷贝test3下的test5工作簿的sheet1工作表的B1:B4单元格；

可为什么老是报错：数组下表越界呀。

实在是百思不得其解！

到底怎么解决这个问题呀，求大神给予解决办法，谢谢！

具体见附件！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-12-12 21:56

1.     Dim strPath$
   
2.     Dim wb As Workbook
   
3.     strPath = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "") - 1)
   
4.     Set wb = GetObject(strPath & "\test1\test3.xlsx")
   
5.     Application.ScreenUpdating = False
   
6. 
   
7.     With wb
   
8.         ThisWorkbook.Sheets("sheet1").Range("a1:a4").Value = .Sheets("sheet1").Range("a1:a4").Value
   
9.         Windows(.Name).Visible = True
   
10.         .Close False
    
11.     End With
    
12.    
    
13.     Set wb = Workbooks.Open(strPath & "\test2\test4.xlsx")
    
14.     With wb
    
15.         ThisWorkbook.Sheets("sheet1").Range("b1:b4").Value = .Sheets("sheet1").Range("b1:b4").Value
    
16.         Windows(.Name).Visible = True
    
17.         .Close False
    
18.     End With
    
19.     ThisWorkbook.Save
    
20.     Application.ScreenUpdating = True
    
21.     MsgBox "复制完成"

复制代码

跳转到最佳答案楼层

hwc2ycy

越界就是你访问了一个不存在的数组元素。
访问集合时指定的索引号或名称有误。

victory610

版主达人，那我这个代码应该怎样改才行呀，谢谢你啦。

hwc2ycy

1.     Dim strPath$
   
2.     Dim wb As Workbook
   
3.     strPath = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "") - 1)
   
4.     Set wb = GetObject(strPath & "\test1\test3.xlsx")
   
5.     Application.ScreenUpdating = False
   
6. 
   
7.     With wb
   
8.         ThisWorkbook.Sheets("sheet1").Range("a1:a4").Value = .Sheets("sheet1").Range("a1:a4").Value
   
9.         Windows(.Name).Visible = True
   
10.         .Close False
    
11.     End With
    
12.    
    
13.     Set wb = Workbooks.Open(strPath & "\test2\test4.xlsx")
    
14.     With wb
    
15.         ThisWorkbook.Sheets("sheet1").Range("b1:b4").Value = .Sheets("sheet1").Range("b1:b4").Value
    
16.         Windows(.Name).Visible = True
    
17.         .Close False
    
18.     End With
    
19.     ThisWorkbook.Save
    
20.     Application.ScreenUpdating = True
    
21.     MsgBox "复制完成"

复制代码

victory610

太感谢版主大人啦，虽然我看不懂这些代码，但我会好好学习的。