Multi-Workbook Consolidation Calculation

Public Sub Quickconsolidatemethod () ' Declaration variable 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 Object Set Wb = Application.thisworkbook Set Sht = Wb.activesheet Set Rng = Sht.range (range_address) Set Firstcel L = rng.cells (1, 1) ' Total result output position upper left corner rangeaddress = rng.address (referencestyle:=xlr1c1) ' Select cell address in specified format FolderPath = Wb.path & "\ Departments \" ' Departmental workbooks folder FileIndex = 0 filename = Dir (FolderPath & "*.xls*") do While FileName <&G T "" FileIndex = fileindex + 1 ReDim Preserve Arr (1 to fileindex) Set OPENWB = Application.Workbooks.Op  En (FolderPath & FileName) ' If the worksheet already has a uniform name, you do not need to open Set Onesht = openwb.worksheets (sheet_index) ARR (FileIndex) = "'" & FolderpaTh & "[" & FileName & "]" & Onesht.name & "'!" & rangeaddress ' construct reference address Openwb.close False ' off Closed file filename = Dir Loop ' Perform the combined calculation method Firstcell.consolidate Sources:=arr, Function:=xlsum, Toprow:=false, left Column:=false, Createlinks:=false ' Release object Set Wb = Nothing:set Sht = Nothing Set Rng = Nothing:set OPENWB = Nothi ng Set Onesht = NothingEnd Sub

　　

Multi-Workbook Consolidation Calculation