问题:将当前文件夹中,各个Excel文件中的Sheet1工作表中的数据汇总到汇总表中。
待汇总数据:
结果:
代码:
'Function:汇总与当前工作簿同在同一文件夹中,结构相同的工作表数据到当前工作簿汇总表中
'仅适用于不带公式的数据汇总
'汇总表应事先放好表头
'使用时,只需改常量k的值即可。
Sub ReportSummary()
'变量声明
Dim myFile$, iRow&, sht As Worksheet
'设定一个常量,它的值为2
'第1行是字段名,要从第2行起复制数据
'可根据数据实情修改该值,如表头有3行,则该值设为4
Const k As Byte = 2
'关掉屏幕更新
Application.ScreenUpdating = False
'将正在运行当前代码的工作簿中的汇总工作表赋给对象变量sht
Set sht = ThisWorkbook.Sheets('汇总')
iRow = sht.Range('A' & Rows.Count).End(xlUp).Row
'清空汇总表第k行以下所有数据,准备接收数据
sht.Rows(k & ':' & Rows.Count).ClearContents
'返回当前工作簿所在路径中的Excel文件
myFile = Dir(ThisWorkbook.Path & '\*.xls*')
'开始循环
Do While myFile > ' '
'跳过当前代码正在运行的工作簿
If myFile <> ThisWorkbook.Name Then
'打开找到的Excel文件,使它成为活动工作簿
Workbooks.Open (ThisWorkbook.Path & '\' & myFile)
'对打开的活动工作簿的Sheet1工作表进行操作
'待汇入的数据在该表当中
With ActiveWorkbook.Sheets('Sheet1')
'取方才打开的活动工作簿Sheet1表中A列最后一个有数据的单元格所在行的行号赋给变量iRow
iRow = .Range('A' & Rows.Count).End(xlUp).Row
'复制标题行以下的行至正在运行当前代码的工作簿的汇总工作表中
'从汇总表A列有数据的最后一个单元格下面的一个单元格起
.Rows(k & ':' & iRow).Copy sht.Range('A' & Rows.Count).End(xlUp).Offset(1, 0)
'关闭打开的工作簿,不保存
Windows(myFile).Close False
End With
End If
'查找下一个工作簿
myFile = Dir
'处理完一个Excel文件后绕回Do继续
Loop
Application.ScreenUpdating = True
MsgBox '汇总完成!', 64, '提示'
End Sub
看图:
联系客服