[已解决]批量移动复制工作表

billyzhang0609

如何将附件中的excel合并，每个excel的sheet1，合并到一个新的excel里面；
比如文件夹有N个文件，那就生成一个新的excel，含有N个sheet；
sheet的名字就是每个文件的文件名（不带扩展名），sheet的内容就是每个文件当前打开页面的所有内容。

相当于“批量的移动复制工作表”的意思。

最佳答案

月排行榜 / 总排行榜

dsmch

2015-2-16 14:20

复制每个工作簿的第一张工作表，原附件有改动

跳转到最佳答案楼层

dsmch

sheet的内容就是每个文件当前打开页面的所有内容，这个要求有点像刻舟求剑了，建议从新编辑要求

dsmch

1. Sub Macro1()
   
2. Dim mypath$, wj$, i%
   
3. mypath = ThisWorkbook.Path & ""
   
4. wj = Dir(mypath & "*.xls*")
   
5. Application.ScreenUpdating = False
   
6. Application.DisplayAlerts = False
   
7. For i = 1 To Sheets.Count
   
8.     If Sheets(i).Name <> "界面" Then Sheets(i).Delete
   
9. Next
   
10. Do While wj <> ""
    
11.     If wj <> ThisWorkbook.Name Then
    
12.         With GetObject(mypath & wj)
    
13.             .Sheets(1).Copy after:=ThisWorkbook.Sheets(Sheets.Count)
    
14.             ActiveSheet.Name = Split(.Name, ".xls")(0)
    
15.             .Close 0
    
16.         End With
    
17.     End If
    
18.     wj = Dir
    
19. Loop
    
20. Application.DisplayAlerts = True
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码

dsmch

复制每个工作簿的第一张工作表，原附件有改动

billyzhang0609

dsmch 发表于 2015-2-16 14:20
复制每个工作簿的第一张工作表，原附件有改动

发自内心的给你点赞，祝新年快乐！