execl表格的合并从简单方面说，只需要复制粘贴每一张表格到一个统一的工作表即可，但是从工作方面考虑，表格中的重复项是否需要合并，重复项的数据是否需要累计汇总，每个表格不同的项目怎么筛选并追加到汇总表中等问题，都是合并多个工作表时，我们需要考虑的问题。另外如果工作表只有几张还可以，如果工作表有几百张都需要汇总怎么办？手动复制明显效率低下，而且错误率高。怎么办？
如何快速、高效的合并多个工作表呢？那么采用vba编程方式来解决就是我们不二之选。
以下的例子就是一个多工作表合并的实例。
实例中采用VBA宏方式，先建立汇总按钮，然后绑定编辑好的宏即可，多少个表都可以，只要execl能容纳下，每个表格必须格式一样，汇总表在任何位置都可以。汇总的功能如下，汇总表把每一页表格相同项合并，数量累加，同时将每一个表的新增项添加入汇总表，同时累加。希望这个例子能对你的工作有帮助。
实例如下：
某连锁社区超市，不同分店的库存表需要汇总，工作表数据既有重复的又有不同的。工作表有4张（模拟四个分店），汇总到一个表中。
1、汇总后的汇总表，按汇总按钮进行对工作表汇总，按清除按钮清楚汇总结果。
其中各工作表格式：
表三、表四格式相同略过。
VBA代码：
Sub 合并()Dim i As IntegerDim j As IntegerDim k As IntegerDim l As IntegerDim n As IntegerDim a() As VariantDim b() As VariantDim c(1 To 1000, 1 To 3) As Variant ScreenUpdating = False'-------------------------------------------------------For i = 1 To Worksheets.Count '循环工作簿中所有工作表 If ActiveSheet.Name <> Worksheets(i).Name Then '判断是否为汇总表，是的 '话进行下一个表单。 a() = Worksheets(i).UsedRange.Value '获取工作表数据 Else GoTo nextsheet End If If i = 1 Then '判断是否为第一张表，是的话， b() = Worksheets(i).UsedRange.Value '直接复制并进行下一个表。 GoTo nextsheet End If'------------------------------------------------------- For j = LBound(a) + 1 To UBound(a) '汇总同类数量 For k = LBound(b) + 1 To UBound(b) If a(j, 1) = b(k, 1) And a(j, 2) = b(k, 2) Then b(k, 3) = b(k, 3) + a(j, 3) Exit For End If Next'------------------------------------------------------- If k = UBound(b) + 1 Then '汇总新增加种类 c(l + 1, 1) = a(j, 1) c(l + 1, 2) = a(j, 2) c(l + 1, 3) = a(j, 3) l = l + 1 End If Next'------------------------------------------------------- Range("z1").Resize(UBound(b), UBound(b, 2)) = b() '增加汇总表空间 b() = Application.WorksheetFunction.Transpose(b) ReDim Preserve b(1 To 3, 1 To UBound(b, 2) + l) b() = Application.WorksheetFunction.Transpose(b) b() = Range("z1").Resize(UBound(b), UBound(b, 2)) Range("z1").Resize(UBound(b), UBound(b, 2)).Clear'------------------------------------------------------- For n = 1 To l '合并新增加种类到汇总表 b(UBound(b) - l + n, 1) = c(n, 1) b(UBound(b) - l + n, 2) = c(n, 2) b(UBound(b) - l + n, 3) = c(n, 3) Next'------------------------------------------------------- Erase c() '清空临时数据 l = 0 nextsheet: Next'-------------------------------------------------------Range("A1").Resize(UBound(b), UBound(b, 2)) = b() '生成汇总表 ScreenUpdating = ture End Sub
