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