【原】EXCEL中利用VBA编程进行多工作表汇总

之前前给大家介绍过一种不用VBA就能实现汇总的方法，今天给大家介绍一下用VBA进行操作的汇总。

我用的还是这个素材：

汇总的目标是把各个省市的表汇总到一张表上，用VBA最终的操作非常简单，点个按钮的事，但编程要花点时间，如果这个汇总是周而复始或量比较大，建议用VBA编程，但如果量少且偶尔发生就按之前的方法做就可以了。

先看效果，是不是很帅，就点了下按钮而已。

EXCEL中利用VBA编程进行多工作表汇总

步骤其实很简单，跟着我来操作：

1.在各省市的文件夹下面新建一个新的工作簿，然后ALT+F11打开VBA编程界面，记得把这个工作簿一定要设为启用宏的工作簿，文件后缀名是xlsm就没错了。

2.然后选择插入-模块，双击模块，在弹出的框里输入以下程序。

EXCEL中利用VBA编程进行多工作表汇总

其实这段代码的基础是在网上找的，然后根据我的底稿做了修改，我基本也在个程序语句后面都做了注释，也就是紫色的汉字。其实VBA没有想象的复杂，会一些简单的语句之后，其实是可以借助网上的一些资源加以修改后就能使用的，具体如下所示：

Sub 汇总各省市()

Dim r As Long

r = 1 '标题性

Range(Cells(r + 1, "A"), Cells(Rows.Count, "B")).ClearContents

'清除数据后再复制，以免产生错误

Application.ScreenUpdating = False

'这个就是个关闭屏幕更新的，从名称也能看出来，主要是提高效率，省的晃眼睛，没啥实际操作动作

Dim filename As String, wb As Workbook, sht As Worksheet, erow _As Long, fn As String, arr As Variant

'对各变量的类型进行定义，主要是有些是文本，有些是数字等等，作用不同

filename = Dir(ThisWorkbook.Path & "\*.xls")

'确定汇总表所在工作簿的文件夹路径，限定程序的范围

Do While filename <> ""

If filename <> ThisWorkbook.Name Then

'判断文件是否为程序所在工作簿，不是的话就继续操作

erow = Range("A1").CurrentRegion.Rows.Count + 1

'这个是要找到从A1单元格连续的区域的最后一行后再加1，那就是非空行第一行

fn = ThisWorkbook.Path & "\" & filename

Set wb = GetObject(fn)

'将fn代表的工作簿对象赋给变量

Set sht = wb.Worksheets(1)

'汇总到第一张工作表

arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(Rows.Count, _"B").End(xlUp).Offset(0, 2))

'将数组arr中的数据写入工作表

Cells(erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

'给下一个赋值提供新的粘贴的位置信息，这样就能把各个文件中内容挨个填入汇总工作簿的工作表1中

wb.Close False

End If

filename = Dir

Loop

Application.ScreenUpdating = True '打开屏幕更新

End Sub

3.加一个按钮，插入一个对象就行，比如图形、个人美照，开发工具中的按钮也行，反正看个人爱好，我就是插入-形状、选了个长方形，然后点击图形图片，鼠标点击右键选择指定宏，找到程序的名称“汇总各省市”选中，点击下方确定按钮就可以了。

EXCEL中利用VBA编程进行多工作表汇总

如果喜欢我的文章，欢迎关注微信公众号：跟我学EXCEL图表