Public Sub QuickConsolidateMethod()

    ‘聲明變量

    Dim Wb As Workbook, OpenWb As Workbook

    Dim Sht As Worksheet, OneSht As Worksheet

    Dim Rng As Range, OneRng As Range, RangeAddress As String

    Const SHEET_INDEX = 1

    Const RANGE_ADDRESS = "C5:L17"

    Dim FirstCell As Range

    Dim Arr() As String

    ReDim Arr(1 To 1)

    Dim FolderPath, FileName, FileIndex

    ‘設置對象

    Set Wb = Application.ThisWorkbook

    Set Sht = Wb.ActiveSheet

    Set Rng = Sht.Range(RANGE_ADDRESS)

    Set FirstCell = Rng.Cells(1, 1) ‘合計結果輸出位置的左上角

    RangeAddress = Rng.Address(ReferenceStyle:=xlR1C1) ‘選用指定格式的單元格地址

    

    FolderPath = Wb.Path & "\各部門\" ‘各部門工作簿文件夾

    FileIndex = 0

    FileName = Dir(FolderPath & "*.xls*")

    Do While FileName <> ""

        FileIndex = FileIndex + 1

        ReDim Preserve Arr(1 To FileIndex)

        Set OpenWb = Application.Workbooks.Open(FolderPath & FileName) ‘若工作表已經有統一名稱，則不需要打開

        Set OneSht = OpenWb.Worksheets(SHEET_INDEX)

        Arr(FileIndex) = "‘" & FolderPath & "[" & FileName & "]" & OneSht.Name & "‘!" & RangeAddress ‘構造引用地址

        OpenWb.Close False ‘關閉文件

        FileName = Dir

    Loop

    ‘執行合並計算方法

    FirstCell.Consolidate Sources:=Arr, Function:=xlSum, TopRow:=False, LeftColumn:=False, CreateLinks:=False

    ‘釋放對象

    Set Wb = Nothing: Set Sht = Nothing

    Set Rng = Nothing: Set OpenWb = Nothing

    Set OneSht = Nothing

End Sub

多工作簿合並計算