VBA-将文件夹中多个相同格式的workbook数据合并到一个workbook中_henry_dx_新浪博客

'将文件夹中多个相同格式的workbook数据合并到一个workbook中

Sub HzwWb()

    Dim bt As Range, r As Long, c As Long

    r = 1                                                                   '表头行数

    c = 4                                                                   '表头列数

    Range(Cells(r + 1, "a"), Cells(1024576, c)).ClearContents               '清除汇总表中原数据

    Application.ScreenUpdating = False

    Dim filename As String, wb As Workbook, 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            '取得汇总表中第一条空行行号

                fn = ThisWorkbook.Path & "\" & filename

                Set wb = GetObject(fn)                                                           '将fn代表的工作簿变量赋给wb

                Set sht = wb.Worksheets(1)                                       '汇总的是每个工作簿中的第一张工作表

                '将数据表中的记录保存在arr变量中                

                arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(1024576, "B").End(xlUp).Offset(0, c - 1))   

               '将arr数据写入汇总表                

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

                wb.Close False

            End If

            filename = Dir                                                                 '用dir函数取得其他文件名，并赋给变量

        Loop

    Application.ScreenUpdating = True

End Sub