实用VBA：15 一键批量汇总工作表的更优方法

1.需求场景

此前介绍了一键批量汇总工作簿和工作表的方法。简单介绍起见，当时汇总工作表的思路是将各个表格中的内容一股脑复制粘贴到当前工作表中。但这样带来的问题是汇总效果不理想，一是汇总表格中会重复出现标题行，二是实际工作中我们未必需要汇总整个表，也许只需要汇总特定的几列数据。现在我们对汇总数据的自定义方法进行优化。

2.解决思路

前提是我们已经按照此前介绍的方法将多个工作簿中的表格汇总到同一个工作簿中。

现在，我们新建一个”数据汇总表“放在第2个表格的位置，仅从其他表格中将标题行复制过来。用于保存从各个表格复制过来的数据。

excel中的表格就像数组一样，是有一个索引值的，可以理解为编号，也就是当前表格在页面上从左向右的顺序号，因此，我们可以将需要汇总的数据表统一排布在右侧，然后按照表格索引值循环访问各个表格，复制其中需要的区域，再回到汇总表中按顺序粘贴即可。

3.VBA实现

Sub 汇总工作表()

    '定义循环访问工作表的起始索引号，循环变量，数据汇总表行号变量

    Dim iStart, j, dataRow As Integer

    '定义工作簿变量和工作表变量

    Dim wb As Workbook

    Dim ws As Worksheet

    '设置工作簿为当前文件

    Set wb = Workbooks(1)

    Set ws = Worksheets("数据汇总表")

    '激活工作表

    ws.Activate

    '关闭屏幕刷新

    Application.ScreenUpdating = False

    '设置复制工作表起始索引号

    iStart = 3

    '循环复制各工作表前5列内容到汇总表中

    For j = iStart To Sheets.Count

         '定位至当前数据末尾行的下一行

        dataRow = Range("A65536").End(xlUp).Row + 1

        '激活复制的工作表

        Sheets(j).Activate

        Sheets(j).Range("A2:E" & Range("A65536").End(xlUp).Row).Copy

        '切换到汇总表

        ws.Activate

        ws.Range("A" & dataRow).PasteSpecial

    Next

    

    Range("A1").Select

    '打开屏幕刷新

    Application.ScreenUpdating = True

    '释放工作簿和工作表变量

    Set ws = Nothing

    Set wb = Nothing

    '输出提示信息

    MsgBox "汇总完成。"

End Sub

4.运行效果

我们可以看到，共有12个分表，每个表20行，加上标题行共241行。所有数据都汇总到了一起，但从分表中复制时都是从第二行开始的，标题行都没有复制过来。这样更符合我们的实际需求。

下一个问题是，如果我汇总了几百个表格过来，汇总到同一个表之后，我想将这几百个分表再统一删除掉，怎么处理会更快呢？也可以一键批量完成，下一篇分享。

喜欢的话欢迎关注、点赞、转发或评论交流！

点赞富三代，分享美一生！ ^|^

往期列表：

实用VBA：1.向下填充空白单元格

实用VBA：2.隔行插入空白行

实用VBA：3.向下合并空白单元格

实用VBA：4.按列拆分工作表

实用VBA：5.批量汇总工作簿、合并工作表

实用VBA：6.一键批量提取文件名和存储路径

实用VBA：7.按文件列表一键汇总excel工作簿

实用VBA：8.一键输出多表格为单独文件

实用VBA：9.使用Excel批量套模板，一键输出多个工作表

实用VBA：10.用VBA向Excel文件中自动插入图片

实用VBA：11.用Excel自动生成商品调拨单

实用VBA：12.用VBA将txt文本文件导入Excel表格

实用VBA：13.Excel数据批量套模板输出pdf文件

实用VBA：14.在二维数组中查找特定元素

实用VBA：15 一键批量汇总工作表的更优方法