嘻皮客娱乐学习网

标题: 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代码:

  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,然后点”编辑“,就可以看到了。

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




欢迎光临 嘻皮客娱乐学习网 (http://www.xipick.com/) Powered by Discuz! X3.3