Excel VBA工作薄 5.8多个工作薄合并-简易版

前景提要

之前我们分享了如何汇总合并多个工作薄的数据，可能因为节奏进展的太快了，有些童鞋可能觉得有点跟不上节奏，因为私下有童鞋和我说，能不能分享一个简单的工作薄汇总的案例，因为实际工作中暂时接触不到这样多样化的需求，上节的方法又有点太复杂，那么今天和大家分享一个简易版的工作薄汇总的方法

场景模拟

根据之前小伙伴们的要求，这里我就稍微改动下数据，将原来的合计这一列替换成为产品4

这样一来我们要处理的数据就变成了这样了，我们要做的事情也更加的简单，只需要将所有的数据汇总即可

方法分析

相对于我们之前的要求，本次的要求是降低了很多，不需要固定的字段，可以减少很多的判断和步骤，如果对于上节内容还不是很了解的童鞋，也可以先看看这篇文章的内容，然后再去回头看看上节的知识。

代码区

Sub test()Dim pathn, sth As Workbook, rng As Range, rng1 As Range, sbook As Workbook, arrT, k&k = 0pathn = ThisWorkbook.PathSet sbook = ThisWorkbookf = Dir(pathn & "\")Do While f <> "" l = Cells(Rows.Count, 1).End(xlUp).Row If f <> "test.xlsm" Then For Each sth In Workbooks If sth.Name = f Then GoTo line End If Next sth '=====汇总工作薄的代码====== k = k + 1 If k = 1 Then Workbooks.Open (pathn & "\" & f) Set rng = ActiveSheet.UsedRange rng.Copy sbook.Worksheets(1).Cells(1, 1) Else l1 = Cells(1, Columns.Count).End(xlToLeft).Column arrT = Range(Cells(1, 1), Cells(1, l1)) Workbooks.Open (pathn & "\" & f) Set rng = ActiveSheet.UsedRange arrW = rng.Rows(1) l2 = UBound(arrW, 2) For i = 1 To l2 On Error Resume Next Num = WorksheetFunction.Match(arrW(1, i), arrT, 0) If Err.Number = 0 Then rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, Num) Else l3 = sbook.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column 'sbook.Worksheets(1).Columns(l3).Insert sbook.Worksheets(1).Cells(1, l3 + 1) = arrW(1, i) rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, l3 + 1) 'ReDim Preserve arrT(1 To 1, 1 To l3 + 1) 'arrT(1, l3) = arrW(1, i) 'arrT(1, l3 + 1) = arrW(1, l2) End If Next i End If '=====汇总工作薄的代码====== ActiveWorkbook.Close True End Ifline: f = Dir()LoopEnd Sub

为了能够让大家更加清楚的了解到上节的代码的作用和效果，我们这里将上节的一些关键代码注释掉，并且保留原代码，这样大家可以更加清楚的了解相对应的代码所实现的功能，可以根据自己的需要灵活的组合。

我们来看看最终的效果

数据还是比较的完美的，实现了我们的要求，不管字段的先后顺序，仅仅是将所有的数据汇总，方便我们对数据后续的整理和操作。