vba-多个工作簿合并方法1(用到了数组)

来自《别怕excel vba其实很简单》

 

Sub 宏1()
\'
\' 宏1 宏
    Dim bt As Range, r As Long, c As Long
    r = 1
    c = 7
    Dim wt As Worksheet
    Set wt = ThisWorkbook.Worksheets(1)
    wt.Rows(r + 1 & ":1048576").ClearContents
    Application.ScreenUpdating = False
    Dim filename As String, sht As Worksheet, wb As Workbook
    Dim erow As Long, fn As String, arr As Variant
    filename = Dir(ThisWorkbook.Path & "\*.xlsx") \'dir-获取文件名
     \'MsgBox ("这个是：" & ThisWorkbook.Path)-->"这个是C;\...desktop\新建文件夹"
    Do While filename <> ""
        If filename <> ThisWorkbook.Name Then
        　　erow = wt.Range("a1").CurrentRegion.Rows.Count + 1 \'当前区域的行数+1-->获得汇总表第一行的行号
        　　fn = ThisWorkbook.Path & "\" & filename \'将第1个要汇总的工作簿名称赋给变量fn
        　　Set wb = GetObject(fn) \'\'将变量fn代表的工作簿对象赋给wb【fn-string；wb-workbook】
        　　Set sht = wb.Worksheets(1) \'将要汇总的工作表赋给sht
        　　arr = sht.Range(sht.Cells(1, "A"), sht.Cells(1048576, "b").End(xlUp).Offset(0, 5))
        　　\'将工作表中要汇总的记录保存在数组arr中；通过offset来确定复制区域的大小
        　　wt.Cells(erow, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr \'arr的数据写入工作表，将arr的数据赋给cell表示的区域
        　　wb.Close False
        End If
        filename = Dir \'用dir函数取得其他文件名，并赋给变量
    Loop
    Application.ScreenUpdating = True
                                                                                                                    
End Sub