Excel VBA 7.14跨工作薄合并工作表，按照工作表名称分类

前景提要

通过昨天的分享，我们学习了如果通过VBA来实现将多个工作薄内多个工作表进行合并的操作，按照昨天的VBA代码进行操作，我们能够成功的将所有的工作表数据汇总在一个工作表中，不过有时候我们可能并不需要将所有的工作表汇总在一个表中，我们需要将多个工作薄中所有的工作表按照既定的工作表名称汇总，相同的工作表名称的内容汇总在同一个工作表中，那么这样的需要要如何实现呢？

场景模拟

假设我们现在将A\B\C三个班次的所有学习全部进行分组，每组10个人，按照这样的方式来分考场进行考试，方便在考试的过程中，更好的监控学生的实操过程，那么最终得到的数据表也是按照考场分布的学生成绩

这次我们想要得到每个班成绩的所有学生的成绩，以班级为单位进行汇总，分析，如果按照上节的方法就有点不合理了，所有的数据都汇总在一个表，在进行分析，明显数据暂时效果并不好，那么我们如何按照班级来进行区分呢？

代码区

其实按照班次区分，说白了就是按照工作表的名称来进行区分，我们可以遍历当前文件夹所有的工作薄，然后遍历所有的工作表，将最新的数据汇总到指定的班级名称的工作表中就可以了。 来看看代码

Sub sdd()Dim tbook As Workbook, book As Workbook, sth As Worksheet, new_sth As WorksheetSet tbook = ThisWorkbookApplication.ScreenUpdating = FalseWith Application.FileDialog(msoFileDialogFolderPicker) .Title = "请选择要汇总的工作薄所在文件夹" If .Show = -1 Then Filename = .SelectedItems(1) End IfEnd Withk = 0j = 0f = Dir(Filename & "\")Do While f <> "" And f <> tbook.Name k = k + 1 Workbooks.Open Filename & "\" & f Set book = ActiveWorkbook If k = 1 Then For i = 1 To book.Worksheets.Count tbook.Worksheets.Add Next i End If For Each sth In book.Worksheets j = j + 1 If k = 1 Then tbook.Worksheets(j).Name = sth.Name sth.UsedRange.Copy tbook.Worksheets(sth.Name).Cells(1, 1) Else l = tbook.Worksheets(j).UsedRange.Rows.Count sth.UsedRange.Offset(1, 0).Copy tbook.Worksheets(sth.Name).Cells(l + 1, 1) End If Next sth j = 0f = Dir()ActiveWorkbook.Close FalseLoopApplication.ScreenUpdating = TrueEnd Sub

看看代码最终的效果

已A班为例，从上图中可以看出，我们已经将所有的A班学生的数据都汇总在新工作薄的A班的这个工作表中

并且只有A班学生的数据，没有其他班级学生的数据，我们在A班的这个工作表中的所有操作结果，都是针对A班这个集体的，而不会去牵涉其他班，非常完美的达到了我们的要求。

代码分析

With Application.FileDialog(msoFileDialogFolderPicker) .Title = "请选择要汇总的工作薄所在文件夹" If .Show = -1 Then Filename = .SelectedItems(1) End IfEnd Withk = 0j = 0f = Dir(Filename & "\")Do While f <> "" ***********f = Dir()Loop

这一段都是老熟人了，主要是用来方便我们选择要汇总的工作薄所在文件夹，然后进行遍历循环文件夹内的所有工作薄的

Workbooks.Open Filename & "\" & f

打开工作薄的代码，也很熟悉了。

If k = 1 Then For i = 1 To book.Worksheets.Count tbook.Worksheets.Add Next i End If

这段代码的意思是， 如果我们是第一次打开第一个工作薄，我们需要根据第一个工作薄的工作表总数来创建相同数量的工作表，比方说案例中有三个工作表，我们就一次性的创建3个心的工作表

For Each sth In book.Worksheets j = j + 1 If k = 1 Then tbook.Worksheets(j).Name = sth.Name sth.UsedRange.Copy tbook.Worksheets(sth.Name).Cells(1, 1) Else l = tbook.Worksheets(j).Cells(Rows.Count, 1).End(xlUp).Row sth.UsedRange.Offset(1, 0).Copy tbook.Worksheets(sth.Name).Cells(l + 1, 1) End If Next sth

此段代码就是核心代码了，主要遍历循环所有的工作表的，除去k=k+1这个老熟人之外，这里有多了一个J=J+1,我这里来解释下

我的习惯是通过变量的方式来代表当前当前是第几次操作，最开始j=0

当我们操作第一个表的时候，j=1

说明当前正在操作第一个表，我们在tbook这个工作薄创建了3个工作表，那么我们正在操作的第一个表就让他对应当前活动工作表的第一个表就可以了。

说的有点含糊，看下截图就知道了

然后我们就开始重命名，将第一个表重命名成当前的这个工作表，第一个工作表如何表示呢？

Worksheets(1)

放到案例中就是

tbook.Worksheets(j).Name = sth.Name

这样就成功将第一个工作表变成了对应的工作表的名称了，后面的几个都是类似的操作，需要记住一点，没循环完一个工作薄之后，要将J重新等于0 ，为什么呢？

我们看下如果不等于0，会有什么结果

熟悉的下标越界，我们来看看这个时候的j是多少，

j=4,但是我们总共只有3个工作表，没有第4个工作表，所以才会提示下标越界，所以在每完成一次工作薄的遍历之后，记得加上j=0

Next sthj = 0