[已解决]文件夹内所有工作簿插入相同的一张工作表

jk0932

如附件所示，
文件夹内有若干个工作簿，现在需要将工作簿“插入表”的Sheet“插入”，插入到其他所以的工作簿中；
效果如：工作簿“Book1结果示范”效果所示，每个工作簿都需要添加一个Sheet“插入”。
谢谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2015-6-18 09:05

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim mypath$, wj$, sht As Worksheet
   
4. mypath = ThisWorkbook.Path & ""
   
5. Set sht = ThisWorkbook.Sheets("插入")
   
6. wj = Dir(mypath & "*.xls*")
   
7. Application.ScreenUpdating = False
   
8. Application.DisplayAlerts = False
   
9. Do While wj <> ""
   
10.     If wj <> ThisWorkbook.Name Then
    
11.         With Workbooks.Open(mypath & wj)
    
12.             If .Sheets("" & sht.Name) Is Nothing Then
    
13.                 sht.Copy after:=.Sheets(Sheets.Count)
    
14.             End If
    
15.             .Close 1
    
16.         End With
    
17.     End If
    
18.     wj = Dir
    
19. Loop
    
20. Application.DisplayAlerts = True
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim mypath$, wj$, sht As Worksheet
   
4. mypath = ThisWorkbook.Path & ""
   
5. Set sht = ThisWorkbook.Sheets("插入")
   
6. wj = Dir(mypath & "*.xls*")
   
7. Application.ScreenUpdating = False
   
8. Application.DisplayAlerts = False
   
9. Do While wj <> ""
   
10.     If wj <> ThisWorkbook.Name Then
    
11.         With Workbooks.Open(mypath & wj)
    
12.             If .Sheets("" & sht.Name) Is Nothing Then
    
13.                 sht.Copy after:=.Sheets(Sheets.Count)
    
14.             End If
    
15.             .Close 1
    
16.         End With
    
17.     End If
    
18.     wj = Dir
    
19. Loop
    
20. Application.DisplayAlerts = True
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码