我们日常工作中经常需要将多个格式一样的工作薄合并到一个工作薄中。方法有很多，今天我们来学习其中的一种方法。

实现逻辑：

今天要学习的这个实现的方法比较简单，就是相当于手工一个个打开将每个要合并的工作薄里的工作表复制出来粘贴到目标工作表中。只是通一小段代码代替人工一步步的操作去实现。

具体步骤如下：

将如下图所示明细表合并到合并模板中。

总表（合并模板）表如下：

总表是只有表头的空表。

明细表如下：

创建一个新工作表并另存允许运行VBA代码格式的文档合并模板.xlsm。ALT+F11 创建程序模块如下图：

具体内容：

Sub merge_workbook()

'定义变量

Dim n, i As Integer

Dim answer As Integer

Dim myrange As Object

Application.ScreenUpdating = False '禁止屏幕刷新

Application.DisplayAlerts = False '禁止保存对话框提示

n =val( InputBox("请输入要合并的个数"))

For i = 1 To n

Workbooks.Open Filename:="C:\temp\维修资料明细(" & i & ").xlsx" '打开表

Set myrange = Worksheets("维修发料明细").Range("A:A") '定义对象

answer = Application.WorksheetFunction.Count(myrange) '计算内容行数

If answer > 1 Then

Range("A2:P2").Select '选定单元格

Range(Selection, Selection.End(xlDown)).Select '向下扩选单元格

Else

Range("A2:P2").Select '选定单元格

End If

Selection.Copy '复制内容

Windows("合并模板.xlsm").Activate '激活工作薄

Set myrange = Worksheets("Sheet1").Range("A:A") '定义对象

answer = Application.WorksheetFunction.Count(myrange) '计算已合并的行数

Range("A" & answer + 2).Select '定位单元格位置

'Selection.End(xlDown).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False '数值粘贴

Windows("维修发料明细(" & i & ").xlsx").Close '关闭明细表

Next i

Application.DisplayAlerts = True '撤销禁止屏幕刷新

Application.ScreenUpdating = True '撤销禁止保存对话框提示

End Sub

创建程序按钮：

按钮设置就完成了，点击上图的按钮就可运行代码进行合并了。运行如下：

输入要合并的文件数即可。

另：本例的文件目录放在C:\TEMP\，文件的个数按合并文件的明细后的编号。

今天分享的案例就到此了，希望此案例能对大家的日常工作有所帮助。喜欢我的内容请分享，转发、点赞、收藏吧。有任何疑问可以私信我哦。

更多精彩文章：

如何动态改变可编辑区域？

如何让excel报表随着日期动态累加？

动态图表——视图实现 动态图表是怎么来的？

动态图表——创建组实现

Excel 窗体使用--- 制作动态密码登入

EXCEL动态图表看板的制作与美化