清空表格数据_一键汇总各分表数据到总表

╰半夏微凉° 2023-01-06 12:59 124阅读 0赞

诸君好。

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

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

![ec89d9f1277abcdb0d68413c13e2c67c.png][]

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

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

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

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

**代码如下：**

`Sub CollectData()     Dim Sht As Worksheet, Rng As Range, k&, n&     Application.ScreenUpdating = False     '取消屏幕更新，加快代码运行速度     n = Val(InputBox("请输入标题的行数", "提醒", 1))     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                 [b1].PasteSpecial Paste:=xlPasteValues                 [a1] = "工作表名称"                 [a1].Offset(n).Resize(Rng.Rows.Count - n, 1) = Sht.Name             Else                 '否则，扣除标题行后再复制黏贴到总表，只黏贴数值                 Rng.Offset(n).Copy                 With Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)                     .Resize(Rng.Rows.Count - n, 1) = Sht.Name                     .Offset(0, 1).PasteSpecial Paste:=xlPasteValues                 End With             End If         End If     Next     [a1].Activate     Application.ScreenUpdating = True '恢复屏幕刷新     MsgBox "汇总OK" End Sub`

--------------------

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

![0f6a83e8b47cd83bcaf0e3e03220af8d.gif][]

**小提示：**

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

[ec89d9f1277abcdb0d68413c13e2c67c.png]: /images/20221119/d73d800e693b4de6a2e1fa363f35b930.png
[0f6a83e8b47cd83bcaf0e3e03220af8d.gif]: https://img-blog.csdnimg.cn/img_convert/0f6a83e8b47cd83bcaf0e3e03220af8d.gif