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