一键汇总各分表数据到总表

写在头部的，如果你是要查学习强国题库的，请点这里！

诸君，下午好。

今天和大家分享的是VBA常用小代码系列第五篇：一键汇总各分表数据到总表。

照例举个栗子，如下图，一个工作簿，包含多个工作表，现在需要将各个分表的数据汇总到总表中。

碰到这样的问题，有些小伙伴会想到使用数据透视表或者合并计算等方式进行操作。

但这两种操作方式都有它的局限性。

比如说，它们是统计汇总数据而不是汇总明细记录；另外，当标题行或列是多行（多列），甚至存在合并单元格时，它们也就无能无力了，等等。

代码一两行，工作不用愁断肠。面对这样的情况，VBA小代码解决方案如下：

代码如下：

Sub CollectData()
    'VBA编程学习与实践，一键多表数据汇总
    Dim Sht As Worksheet, Rng As Range, k&, n&
    Application.ScreenUpdating = False
    '取消屏幕更新，加快代码运行速度
    n = Val(InputBox("请输入标题的行数", "提醒"))
    If n < 0 Then MsgBox "标题行数不能为负数。", 64, "提示": Exit Sub
    '取得用户输入的标题行数，如果为负数，退出程序
    Cells.ClearContents
    '清空当前表数据
    For Each Sht In Worksheets
    '遍历工作表
        If Sht.Name <> ActiveSheet.Name Then
        '如果工作表名称不等于当前表名则进行汇总动作……
            Set Rng = Sht.UsedRange
            '定义rng为表格已用区域
            k = k + 1
            '累计K值
            If k = 1 Then
            '如果是首个表格，则K为1，则把标题行一起复制到汇总表
                Rng.Copy
                [a1].PasteSpecial Paste:=xlPasteValues
            Else
                '否则，扣除标题行后再复制黏贴到总表，只黏贴数值
                Rng.Offset(n).Copy
                Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).PasteSpecial Paste:=xlPasteValues
            End If
        End If
    Next
    [a1].Activate
    Application.ScreenUpdating = True '恢复屏幕刷新
End Sub

操作过程，参考下面的动画教程：

小提示：

该代码是将分表的数据汇总明细到当前工作表，因此在使用时务必先选择汇总表哦！