3分钟写个VBA：Excel工作簿所有子表数据一键汇总

朱小五

发布于 2021-12-09 16:06:49

2.7K0

发布于 2021-12-09 16:06:49

文章被收录于专栏：凹凸玩数据凹凸玩数据凹凸玩数据

今天同事问我，他要汇总一个工作簿里面十几张子表里面的数据到同工作簿的汇总表里面，怎么操作比较快？然后我就想到了VBA，3分钟给他写（录）了一个宏，一键完成所有数据汇总。

所以今天我就分享这个小技巧，不需要VBA脚本很熟悉的盆友也可以上手哦，非常简单易行。

1、首先，看看需求，有下面一张Excel工作簿，需要把除了【数据汇总】以外的三张子表里面的内容（可以更多的子表，但是这里只是举例三张子表），汇总到【数据汇总】，其中子表的数据格式是一样的，就是说表头是一样的。

△三张子表

△【数据汇总】sheet

2、接着，点击开发工具，录制宏，填写宏名，当然也可以默认，再点击确定。

△开发工具

△录制宏

3、接着，选择【Sheet1】表里面的内容复制，粘贴到【数据汇总】工作表。和平常的复制粘贴操作一样，目的就是录制你的操作过程，然后转换成代码，再利用代码自动执行。

4、然后，点击【停止录制按钮】，在【数据汇总】工作表点击鼠标右键，点击【查看代码】。

点击【模块3】，就可以看到我们之前录制的操作生成的代码了，这里是复制了【Sheet1】，【Sheet2】表里面的数据到数据汇总表里面的代码。

5、然后，优化脚本，写个循环的代码。

但是优化完好像和录制的代码毫不相关。。。。其实录制的主要目的就是看着录制的代码可以想起代码的语句、逻辑等是怎么样的，因为不常用，所以我记不住关键语句o(￣︶￣)o；

Sub 数据汇总()
'
' 数据汇总 宏

 Dim sht As Worksheet

 With Sheets("数据汇总")
  For Each sht In Worksheets
    If sht.Name <> "数据汇总" Then '将各子表复制粘贴到Sheets("数据汇总")表里面
        sht.Range("A2:F" & sht.Range("a65536").End(xlUp).Row).Copy  '将需要被复制的各个子表的表头以下有数据的位置复制
        Range("A" & Range("a65536").End(xlUp).Row + 1).PasteSpecial  '粘贴到数据汇总表中有数据的行的下一个空白单元格的位置
       
    End If
  Next
  Range("I1").Select
 End With

End Sub

6、最后，点击保存脚本之后，就可以执行。如何执行代码？这里有两个方法。

第一种方法，回到工作簿，在开发工具，点击宏，选择对应的宏的名称，点击执行。