[已解决]请教大神：怎样跨工作簿复制？谢！

白云无尽9987

请教大神：怎样跨工作簿复制？谢！.rar (27.35 KB, 下载次数: 10)

2017-6-2 15:51 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

chart888

2017-6-2 16:14

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Dim MyPath$, MyName$, sh As Workbook, r%
   
4. Dim arr
   
5. On Error Resume Next
   
6. 
   
7. MyPath = ThisWorkbook.Path & "\mm"
   
8. MyName = Dir(MyPath & "*.*")
   
9. Application.ScreenUpdating = False
   
10. a = 5
    
11. Do While MyName <> ""
    
12.     Set sh = GetObject(MyPath & MyName)
    
13.     arr = sh.ActiveSheet.Range("E11:E30")
    
14.     Workbooks(MyName).Close False
    
15.     Cells(a, 3).Resize(UBound(arr), 1) = arr
    
16.     a = Range("C65536").End(xlUp).Row + 1
    
17.     MyName = Dir
    
18. Loop
    
19. 
    
20. Application.ScreenUpdating = True
    
21. 
    
22. End Sub
    
23. 
    
24. 
    

复制代码

跳转到最佳答案楼层

chart888

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Dim MyPath$, MyName$, sh As Workbook, r%
   
4. Dim arr
   
5. On Error Resume Next
   
6. 
   
7. MyPath = ThisWorkbook.Path & "\mm"
   
8. MyName = Dir(MyPath & "*.*")
   
9. Application.ScreenUpdating = False
   
10. a = 5
    
11. Do While MyName <> ""
    
12.     Set sh = GetObject(MyPath & MyName)
    
13.     arr = sh.ActiveSheet.Range("E11:E30")
    
14.     Workbooks(MyName).Close False
    
15.     Cells(a, 3).Resize(UBound(arr), 1) = arr
    
16.     a = Range("C65536").End(xlUp).Row + 1
    
17.     MyName = Dir
    
18. Loop
    
19. 
    
20. Application.ScreenUpdating = True
    
21. 
    
22. End Sub
    
23. 
    
24. 
    

复制代码