Excel 实现将多个工作薄合并到一个工作薄的方法？

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

实现逻辑：

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

具体步骤如下：

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

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

总表是只有表头的空表。

明细表如下：

创建一个新工作表并另存允许运行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\，文件的个数按合并文件的明细后的编号。

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