玖叶教程网

年底总公司数据报表汇总是一件重大的工作量，如果你看到了我的这篇分享你的工作可以用秒来完成。

假如你在一个文件夹里放了很多工作簿，工作簿里面又有很多工作表，你须要把所有工作簿及工作簿表里面的内容汇总到一个工作簿表里面，你可以采用下面这段码能帮你轻松完成工作

下面是代码分享

Sub 汇总工作簿()

Dim sr$, sr2 As Workbook, sr3 As Worksheet, sr4 As Range, sr5 As Range, gs$ 申明变量

Columns("a:d").ClearContents 清除整列内容

Range("a1") = "员工ID": Range("b1") = "姓名": Range("c1") = "部门": Range("d1") = "分公司"

sr = Dir(ThisWorkbook.Path & "\*分公司*") 遍历文件夹下文件名

Do 无限循环开头

Set sr2 = Workbooks.Open(ThisWorkbook.Path & "\" & sr) '如果打开的工作簿要赋给变量，路径须要加上括号。

For Each sr3 In sr2.Worksheets 循环工作表

Set sr4 = sr3.Range("a2", sr3.Range("b1").End(xlDown)) 动态获取单元格区域

Set sr5 = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 定格当前单元格

sr4.Copy sr5 复制内容

sr5.Offset(0, 2).Resize(sr4.Rows.Count, 1) = sr3.Name 把工作表名字赋值给单元格

gs = VBA.Left(sr2.Name, InStr(sr2.Name, ".") - 1) 提取公司名去后缀

sr5.Offset(0, 3).Resize(sr4.Rows.Count, 1) = gs 公司名赋值给单元格

Next 循环尾

sr2.Close 关闭工作簿

sr = Dir 继续遍历文件夹里下一个文件名

Loop Until sr = "" 无限循环条件达到结束循环

End Sub