大家好，我是星光，今天给大家分享是VBA常用小代码系列的第五篇——一键汇总分表数据。

举个栗子，如下图，一个工作簿，有多个分表，现在需要将他们快速汇总到一个工作表中。

http://ww1/large/005IRek6gw1f6hr8iysfkj30dx0a9tb7.jpgVBA篇】VBA常用小代码（五）一键汇总分表数据" TITLE="【Excel VBA篇】VBA常用小代码（五）一键汇总分表数据" />

有些朋友可能会想到用透视表、合并计算等。但这里需要说明的是， 这里的多表汇总只是汇总明细，不需要对明细进行统计求和等运算，此外，标题行，也可能是双行标题，甚至含合并单元格的情况……嘻嘻~~

VBA代码参考如下：

Sub collect()
    '新浪微博@EXCELers，一键多表数据汇总
    Dim sht As Worksheet, rng As Range, k&, trow&
    Application.ScreenUpdating = False
    '取消屏幕更新，加快代码运行速度
    trow = Val(InputBox("请输入标题的行数", "提醒"))
    If trow < 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(trow).Copy
                Cells(ActiveSheet.UsedRange.Rows.Count 1, 1).PasteSpecial Paste:=xlPasteValues
            End If
        End If
    Next
    [a1].Activate
    '激活A1单元格
    Application.ScreenUpdating = True
    '恢复屏幕刷新
End Sub

操作过程及使用说明见演示动画：

http://ww3/large/005IRek6gw1f6hsd7igymg30jy0i9kjm.gifVBA篇】VBA常用小代码（五）一键汇总分表数据" TITLE="【Excel VBA篇】VBA常用小代码（五）一键汇总分表数据" />

小提示：

这个代码是将分表的数据快速合并到当前工作表，所以在使用时，务必先选择汇总表。

如果不会使用VBA代码，可以参考这个帖子：黑技术~秒破工作表加密！里面有使用VBA代码的图文教程哈~。

最后照例贴送示例文件百度网盘：百度网盘 （网盘里还有很多惊喜~~）

此前及后续更多VBA常用小代码，请关注：@EXCELers