[已解决]有关批量复制的VBA代码请求高手指点帮助

白云无尽9987

111.rar (24.62 KB, 下载次数: 9)

2015-6-20 17:08 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

qh8600

2015-6-20 18:01

1. Sub 按钮1_Click()
   
2. 
   
3.     Dim bk As Workbook, ph, ph1, sh As Worksheet, rg
   
4.     Application.DisplayAlerts = False
   
5. 
   
6.     Application.ScreenUpdating = False
   
7. 
   
8.     rg = Range("a1").Value   '要求复制的位置在这
   
9. 
   
10.     ph = ThisWorkbook.Path & ""
    
11. 
    
12.     ph1 = Dir(ph & "*.xls")
    
13. 
    
14.     Do While ph1 <> ""
    
15. 
    
16.         If ph1 <> ThisWorkbook.Name Then
    
17.             Set bk = Workbooks.Open(ph & ph1)
    
18. 
    
19.             For Each sh In bk.Worksheets
    
20.                 sh.Range("a2") = rg    '要求粘贴的位置在这
    
21. 
    
22.             Next sh
    
23. 
    
24.             bk.Close True
    
25.         End If
    
26.         ph1 = Dir
    
27. 
    
28.     Loop
    
29. 
    
30.     Application.DisplayAlerts = True
    
31. 
    
32.     Application.ScreenUpdating = True
    
33. 
    
34. End Sub

复制代码

这样试试

跳转到最佳答案楼层

qh8600

1. Sub 按钮1_Click()
   
2. 
   
3.     Dim bk As Workbook, ph, ph1, sh As Worksheet, rg
   
4.     Application.DisplayAlerts = False
   
5. 
   
6.     Application.ScreenUpdating = False
   
7. 
   
8.     rg = Range("a1").Value   '要求复制的位置在这
   
9. 
   
10.     ph = ThisWorkbook.Path & ""
    
11. 
    
12.     ph1 = Dir(ph & "*.xls")
    
13. 
    
14.     Do While ph1 <> ""
    
15. 
    
16.         If ph1 <> ThisWorkbook.Name Then
    
17.             Set bk = Workbooks.Open(ph & ph1)
    
18. 
    
19.             For Each sh In bk.Worksheets
    
20.                 sh.Range("a2") = rg    '要求粘贴的位置在这
    
21. 
    
22.             Next sh
    
23. 
    
24.             bk.Close True
    
25.         End If
    
26.         ph1 = Dir
    
27. 
    
28.     Loop
    
29. 
    
30.     Application.DisplayAlerts = True
    
31. 
    
32.     Application.ScreenUpdating = True
    
33. 
    
34. End Sub

复制代码

这样试试

白云无尽9987

qh8600 发表于 2015-6-20 18:01
这样试试

神了，还真行！！非常感谢！！
追问哈——上述是现在的状况是有几个工作表就粘贴几处，11、22、33、44、55全部粘贴，如果只粘贴到11、33这两个工作表，咋办？——————跪谢！！

这个不好解决就先放一下——还有就是A1对A2的复制粘贴，如果要同时一键完成A1对A2的复制粘贴和C1对C2的粘贴，在某两个位置加入两行代码的思路会有错吗？怎样加入“两行代码”？

qh8600

白云无尽9987 发表于 2015-6-20 19:48
神了，还真行！！非常感谢！！
追问哈——上述是现在的状况是有几个工作表就粘贴几处，11、22、33、44 ...

放入数组

白云无尽9987

qh8600 发表于 2015-6-20 20:36
放入数组

非常感谢！LZ辛苦了！！