使用VBA汇总结构相同的工作表数据（1）

问题：将当前文件夹中，各个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

看图：