嘻皮客娱乐学习网
标题:
excel批量将一个工作薄中的指定工作表复制到同文夹下的多个工作薄内
[打印本页]
作者:
xipick
时间:
2015-1-6 08:41
标题:
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”等工作簿中原来就有以“说明”命名的工作表,会先删除,然后再复制。
(, 下载次数: 214)
上传
点击文件名下载附件
vba代码:
Sub Macro1()
Dim MyPath$, MyName$, sh As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sh = Sheets("说明") '如果要复制的工作表名称不为“说明”,请在这儿修改
MyPath = ThisWorkbook.Path & ""
MyName = Dir(MyPath & "*.xls")
On Error Resume Next
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
m = m + 1
With Workbooks.Open(MyPath & MyName)
.Sheets("说明").Delete '这句的作用是为了防止其他工作薄中已经有以"说明"命名的工作表,先删除之。当然也可以用来批量删除其他名称的工作表
sh.Copy Before:=.Sheets(1)
.Close True
End With
End If
MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "处理完毕,共处理" & m & "个工作簿"
End Sub
复制代码
如果要复制的工作表名称不为“说明”,请修改VBA代码,vba代码修改,请在“说明.xls”工作薄中按ALT+F8,然后点”编辑“,就可以看到了。
指定工作表所在的工作薄的名称可以是任意的,不需要特意修改。
欢迎光临 嘻皮客娱乐学习网 (http://www.xipick.com/)
Powered by Discuz! X3.3