Excel VBA 合并工作表

夏日静好

已于 2023-06-26 10:32:36 修改

阅读量665

点赞数 1

分类专栏： Excel使用技巧文章标签： excel

于 2023-06-01 10:05:57 首次发布

原文链接：https://www.zhihu.com/question/20366713/answer/1514642143?utm_source=zhihu&utm_medium=social&utm_oi=1299754964424835072

版权

Excel使用技巧专栏收录该内容

13 篇文章 1 订阅

订阅专栏

此为转载，只为方便记录，原链接：

如何快速的合并多个 Excel 工作簿成为一个工作簿？https://www.zhihu.com/question/20366713/answer/1514642143?utm_source=zhihu&utm_medium=social&utm_oi=1299754964424835072

代码：

Sub 合并当前工作簿下的所有工作表()
Dim ws As Worksheet
Dim sh As Worksheet, i%
On Error Resume Next '如遇错误继续运行
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '禁用警告提示
Worksheets("汇总").Delete '删除原汇总表
Set ws = Worksheets.Add(before:=Sheets(1)) '新建工作表
ws.Name = "汇总" '新建工作表命名为汇总
For Each sh In Sheets: '遍历所有工作表
If sh.Name <> "汇总" Then '判断工作表是否为汇总表
i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 '获取汇总表中A列数据区域最后一行的行号+1
ws.Cells(i, 3)=sh.Name '复制分表的工作表名,放在第2列（根据实际情况）
sh.UsedRange.Copy '复制分表中的数据
ws.Cells(i+1, 1).PasteSpecial Paste:=xlPasteAll '粘贴数据
ws.Cells(i+1, 1).PasteSpecial Paste:=xlPasteColumnWidths '粘贴列宽
End If
Next
Application.DisplayAlerts = True '恢复警告提示
Application.ScreenUpdating = True '开启屏幕刷新
MsgBox "工作表合并完毕"
End Sub