vba 批量收集汇总EXCEL数据

日常工作中经常会为了汇总多个工作薄，多个工作表的数据选择复制粘贴数据点击到手痛吗？现在分享一下本人使用vba自动汇总方案，希望给职场伙伴们一些帮助，

按照下图整理需要统计的文件夹(当前文档目录下的文件夹），工作薄名，工作表名，对应返回数据（可以为空），是否更新，

亲！格式不一样也可以哦，需要微调代码啊！

启用开发工具选项卡；

1，点击选项，2，点击自定义功能区，3，勾选开发工具

设置控件；

1，插入命令控件；

2，修改控件名称及显示名；

进入VBA编程界面；复制以下代码到编辑窗口

Private Sub 查询汇总_Click()

config = vbYesNo + vbQuestion + vbDefaultButton1

ans = MsgBox("你确认更新数据吗？", config, "提示")

If ans = vbYes Then

Dim cnn As Object, rs As Object, SQL$, i&, A&, B&, C&, D&, E&, sFile$, sFile1$, sFile2$, sFile3$, sFile4$, sFile5$, sFile6$

Dim wb As Object, ws As Object

'取得当前工作表的最后行数

C = ActiveSheet.UsedRange.Rows.Count + 1

'取得当前工作表的最后列数

E = ActiveSheet.UsedRange.Columns.Count

'创建需要更新工作表的循环数据

For D = 2 To Application.WorksheetFunction.CountA(Worksheets("参数").Range("A:A"))

'是否查询

sFile1 = Sheets("参数").Cells(D, 5).Value

'文件夹

sFile2 = Sheets("参数").Cells(D, 1).Value

'工作薄

sFile3 = Sheets("参数").Cells(D, 2).Value

'工作表

sFile4 = Sheets("参数").Cells(D, 3).Value

'返回值

sFile5 = Sheets("参数").Cells(D, 4).Value

'预算路径

sFile = ThisWorkbook.Path & "\" & sFile2 & "\" & sFile3 & ".xlsx"

'判断是否查询

If sFile1 = "是" Then

'判断参数内的工作表的名是否为空,为空时取值当前工作表名

If sFile4 = "" Then

sFile6 = ActiveSheet.Name

Else

sFile6 = sFile4

End If

Cells(1, 11) = "正在更新：" & sFile2 & sFile3

'锁定工作薄焦点

Application.ScreenUpdating = False

Application.ShowWindowsInTaskbar = False

'打开工作薄

Set wb = Workbooks.Open(sFile, False, False)

'打开工作表

Set ws = wb.Worksheets(sFile6)

'当前表行数循环

For A = 2 To wb.Worksheets(sFile6).UsedRange.Rows.Count

Cells(C, 1) = sFile5

For B = 1 To E

Cells(C, B + 1) = wb.Worksheets(sFile6).Cells(A, B).Value

Next

C = C + 1

Next

wb.Close Savechanges:=True

'解除工作薄焦点

Application.ShowWindowsInTaskbar = True

Application.ScreenUpdating = True

Cells(1, 11) = "更新完成！"

End If

Next

MsgBox "更新完成！", vbInformation

If ans = vbNo Then

Exit Sub

End If

End If

End Sub

大功告成，测试图如下，

第二行为表头行，第一列为对应返回数据，从第二列开始是汇总数据