江苏龙网

  1. 首页 > 资讯 > 资讯 > >

一键将多个工作簿合并成多个工作表（完善版）

点击上方蓝字
「Excel不加班」
关注
，
看下一篇



一键将多个工作簿合并成多个工作表（完善版）
文章图片


恭喜下面3位幸运儿：Choicc、LGM海王星、土它@土它
， 获得书籍 ， 加卢子微信
chenxilu2019
。

为了活跃气氛 ， 在文末点亮“在看”+评论区留言 ， 我会从中抽取3名粉丝 ， 每人赠送一本《卢子Excel高手速成视频教程 早做完 ， 不加班》 。

一键将多个工作簿合并成多个工作表（完善版）
文章图片


复制下面这段内容 ， 打开手机淘宝 ， 即可购买 。

付製这行话HVMT1Qm6JF8转移至淘宀┡ē ， 【【卢子2020新书】卢子Excel高手速成视频教程 excel函数公式大全 excel高级教程 电子表格excel教程书 表格制作 excel教程书籍】

一年前的旧文章了 ， 今天突然VIP学员需要这个功能 ， 拿出来完善 。 原文章可以实现一键将多个工作簿合并成多个工作表 ， 不过工作表名称没有重新改名 。

详见：一键合并 ， 12个增值税发票的工作簿

比如 ， 文件夹内有很多工作簿 ， 现在需要将所有工作簿放在Excel不加班教程合并这个工作簿 。
一键将多个工作簿合并成多个工作表（完善版）
文章图片


合并后效果：工作表的名称是以原来工作簿的名称命名 ， 每个工作表放着原来工作簿的内容 。
一键将多个工作簿合并成多个工作表（完善版）
文章图片


将模板放在实际要合并的文件夹内 ， 打开模板 ， 运行即可 。 短短几秒钟 ， 就将所有工作簿合并过来 。
一键将多个工作簿合并成多个工作表（完善版）
文章图片


源代码：

Sub 合并工作簿()
Dim Wb As Workbook, MyPath As String, File, Sh_n As String
Application.ScreenUpdating = False
Rem 关闭屏幕刷新
MyPath$ = ThisWorkbook.Path & "\"
Rem 获取当前工作簿路径
File = Dir(MyPath & "*.xls*")
Rem 获取路径下所有Excel文件
Do While File <> "" '遍历所有文件
If File <> ThisWorkbook.Name Then '不合并当前工作簿
Set Wb = Workbooks.Open(MyPath & File)
Rem 依次打开工作簿
Sh_n = StrReverse(Mid(StrReverse(Wb.Name), InStr(StrReverse(Wb.Name), ".") + 1))
Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Sh_n
Rem 将第一个表复制到当前工作簿的最后一个工作表
Wb.Close False '关闭工作簿 不保存
End If
File = Dir
Rem 循环下一个工作簿
Loop
Application.ScreenUpdating = False
Rem 打开屏幕刷
End Sub


链接：
https://pan.baidu.com/s/1vBehDA_8Z_DXS9NDgBgSTA


推荐阅读


上一篇：2.5天休假，这项福利如何变现？

下一篇：「特朗普」特朗普怒骂记者：你就是个戏精 再吵吵我就走了！