[已解决]请问将其他工作表的内容复制粘贴到同一张工作表，为什么会出错

xxtk

我的目的是将不同工作表的内容复制粘贴到指定工作表的指定区域内。
奇怪的是，我运行完这串代码，只有book4的sheet2 被复制粘贴到了Autoload1 的sheet3上，另一个没成功。
自己也实在看不出来问题在哪儿，能否请大神们帮我看下，谢谢。

sourcing					Destination
DIR	file name	sheet name	range		file name	sheet name	range
C:\Users\19008483\Desktop	Book4.xls	Sheet1	a1:q500		Autoload1.xlsm	sheet2	a1
C:\Users\19008483\Desktop	Book4.xls	Sheet2	a1:q501		Autoload1.xlsm	sheet3	a1

Sub test()
Dim name As String, i%, file, sht, rng, destination, desfile, dessht As String

Application.ScreenUpdating = False
On Error Resume Next

For i = 6 To 10
     name = Range("b" & i).Text & "\" & Range("c" & i).Text
     file = Range("c" & i).Text
     sht = Range("d" & i).Text
     rng = Range("e" & i).Text
     destination = Range("i" & i).Text
     desfile = Range("g" & i).Text
     dessht = Range("h" & i).Text
         
          If file = "" Then GoTo 100
         Workbooks.OpenText Filename:=name
   
         Windows(file).Activate
         Sheets(sht).Range(rng).Select
         Selection.Copy
         Windows(desfile).Activate
   
         Sheets(dessht).Select
         Range(destination).Select
         ActiveSheet.Paste
   
         Workbooks.OpenText Filename:=name
   
         ActiveWindow.Close
      
          Windows("Autoload1.xlsm").Activate
          Sheets("Sheet1").Select
      
Next

100
Application.ScreenUpdating = True
End Sub

最佳答案

月排行榜 / 总排行榜

L50814026

2015-10-27 15:43

1. Sub test()
   
2. 
   
3. Dim name As String, i%, file, sht, rng, destination, desfile, dessht As String
   
4. 
   
5. 
   
6. Application.ScreenUpdating = False
   
7. Application.DisplayAlerts = False
   
8. 'On Error Resume Next
   
9. 
   
10. 
    
11. For i = 6 To 10
    
12.      name = Range("b" & i).Text & "" & Range("c" & i).Text
    
13.      file = Range("c" & i).Text
    
14.      sht = Range("d" & i).Text
    
15.      rng = Range("e" & i).Text
    
16.      destination = Range("i" & i).Text
    
17.      desfile = Range("g" & i).Text
    
18.      dessht = Range("h" & i).Text
    
19.          
    
20.           If file = "" Then GoTo 100
    
21.          Workbooks.OpenText Filename:=name
    
22.    
    
23.          Windows(file).Activate
    
24.          Sheets(sht).Select
    
25.          Range(rng).Select
    
26.          Selection.Copy
    
27.          Windows(desfile).Activate
    
28.    
    
29.          Sheets(dessht).Select
    
30.          Range(destination).Select
    
31.          Selection.PasteSpecial Paste:=xlPasteValues
    
32.    
    
33.          'Workbooks.OpenText Filename:=name
    
34.    
    
35.          Windows(file).Close
    
36.       
    
37.           Windows("Autoload1.xlsm").Activate
    
38.           Sheets("Sheet1").Select
    
39.       
    
40. Next
    
41. 
    
42. 
    
43. 100
    
44. 
    
45. Application.ScreenUpdating = True
    
46. Application.DisplayAlerts = True
    
47. 
    
48. End Sub

复制代码

跳转到最佳答案楼层

xxtk

附件

L50814026

1. Sub test()
   
2. 
   
3. Dim name As String, i%, file, sht, rng, destination, desfile, dessht As String
   
4. 
   
5. 
   
6. Application.ScreenUpdating = False
   
7. Application.DisplayAlerts = False
   
8. 'On Error Resume Next
   
9. 
   
10. 
    
11. For i = 6 To 10
    
12.      name = Range("b" & i).Text & "" & Range("c" & i).Text
    
13.      file = Range("c" & i).Text
    
14.      sht = Range("d" & i).Text
    
15.      rng = Range("e" & i).Text
    
16.      destination = Range("i" & i).Text
    
17.      desfile = Range("g" & i).Text
    
18.      dessht = Range("h" & i).Text
    
19.          
    
20.           If file = "" Then GoTo 100
    
21.          Workbooks.OpenText Filename:=name
    
22.    
    
23.          Windows(file).Activate
    
24.          Sheets(sht).Select
    
25.          Range(rng).Select
    
26.          Selection.Copy
    
27.          Windows(desfile).Activate
    
28.    
    
29.          Sheets(dessht).Select
    
30.          Range(destination).Select
    
31.          Selection.PasteSpecial Paste:=xlPasteValues
    
32.    
    
33.          'Workbooks.OpenText Filename:=name
    
34.    
    
35.          Windows(file).Close
    
36.       
    
37.           Windows("Autoload1.xlsm").Activate
    
38.           Sheets("Sheet1").Select
    
39.       
    
40. Next
    
41. 
    
42. 
    
43. 100
    
44. 
    
45. Application.ScreenUpdating = True
    
46. Application.DisplayAlerts = True
    
47. 
    
48. End Sub

复制代码

xxtk

谢谢！