请问如何用VBA代码合并多个工作簿并保留不同名称的sheet表

Teesys · 发表于 2018-6-23 17:03

本帖最后由 Teesys 于 2018-6-24 06:16 编辑

这边有很多工作簿，其中每个工作簿、每个sheet表的名称都不同，请问有在保留各个sheet名称表与内容的情况下，将所有sheet表汇总到一个工作簿的方法吗
就比如有30个工作簿，每个工作簿有50个工作表，合并成有1500个工作表的一个工作簿

求大神，求老师帮忙

编辑：
经提醒添加了附件！

模板.rar (415.93 KB, 下载次数: 41)

lsc900707 · 发表于 2018-6-23 17:39

没有附件，说再多也是枉然。

朱荣兴 · 发表于 2018-6-24 01:37

提示: 作者被禁止或删除内容自动屏蔽

lsc900707 · 发表于 2018-6-24 10:19

本帖最后由 lsc900707 于 2018-6-24 10:22 编辑

在同目录下新建一个工作簿，代码拷入模块中运行：
Sub gj23w98()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sht In Worksheets
      If sht.Name <> ActiveSheet.Name Then sht.Delete
Next
Set wk = ThisWorkbook
p = ThisWorkbook.Path & "\"
f = Dir(p & "*.xlsx")
Do While f <> ""
      If f <> ThisWorkbook.Name Then
         Set ws = Workbooks.Open(p & f)
         For i = 1 To ws.Sheets.Count
            ws.Sheets(i).Copy after:=wk.Sheets(wk.Sheets.Count)
            wk.Sheets(wk.Sheets.Count).Name = Split(f, ".")(0) & "-" & ws.Sheets(i).Name
         Next
         ws.Close False
      End If
      f = Dir
Loop
Sheets(1).Activate
MsgBox "ok"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

lsc900707 · 发表于 2018-6-24 10:22

附件供参考：

		自动登录	找回密码
密码			免费注册

朱荣兴朱荣兴当前离线性别保密 UID 1318548 阅读权限 0 注册时间 2011-2-2 在线时间小时最后登录 1970-1-1 积分 19282 财富分享技术精华头像被屏蔽 TA的精华主题 TA的得分主题	发表于 2018-6-24 01:37 来自手机 \| 显示全部楼层 [广告] ★ ReportLite:表哥表姐早下班神器，专治各种报表不服，拒绝无意义的重复劳动 ★ 提示: 作者被禁止或删除内容自动屏蔽

	回复举报

[求助] 请问如何用VBA代码合并多个工作簿并保留不同名称的sheet表