excel批量将一个工作薄中的指定工作表复制到同文夹下的多个工作薄内

批量将附件文件夹中的工作薄“指定工作表所在的工作薄.xls”中的工作表“说明”，复制到相同文件夹中的其他“八1.xls”、“八2.xls”、“八3.xls”、“八4.xls”、“八5.xls”、“八6.xls”、“八7.xls”等工作簿中，以原来工作表的形式放置于“八1.xls”等工作簿中，即完成之后“八1.xls”等工作簿中将有两张工作表，一个是原来存在的，第二张是从“说明.xls”中复制过来的。如果“八1.xls”、“八2.xls”、“八3.xls”、“八4.xls”、“八5.xls”、“八6.xls”、“八7.xls”等工作簿中原来就有以“说明”命名的工作表，会先删除，然后再复制。


批量将一个工作薄中的指定工作表复制到同文夹下的多个工作薄内.rar (312.99 KB, 下载次数: 213)

2015-1-6 08:52 上传

点击文件名下载附件

vba代码：

1. Sub Macro1()
   
2.     Dim MyPath$, MyName$, sh As Worksheet
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set sh = Sheets("说明")                                '如果要复制的工作表名称不为“说明”，请在这儿修改
   
6.     MyPath = ThisWorkbook.Path & ""
   
7.     MyName = Dir(MyPath & "*.xls")
   
8.     On Error Resume Next
   
9.     Do While MyName <> ""
   
10.         If MyName <> ThisWorkbook.Name Then
    
11.             m = m + 1
    
12.             With Workbooks.Open(MyPath & MyName)
    
13.                 .Sheets("说明").Delete                    '这句的作用是为了防止其他工作薄中已经有以"说明"命名的工作表，先删除之。当然也可以用来批量删除其他名称的工作表
    
14.                 sh.Copy Before:=.Sheets(1)
    
15.                 .Close True
    
16.             End With
    
17.         End If
    
18.         MyName = Dir
    
19.     Loop
    
20.     Application.ScreenUpdating = True
    
21.     MsgBox "处理完毕，共处理" & m & "个工作簿"
    
22. End Sub

复制代码

如果要复制的工作表名称不为“说明”，请修改VBA代码，vba代码修改，请在“说明.xls”工作薄中按ALT+F8,然后点”编辑“，就可以看到了。

指定工作表所在的工作薄的名称可以是任意的，不需要特意修改。