Dynamic Array for data consolidation

[Len]

Hi,

After I made use the codes from the same thread, modified for my need
and later I found out that I do not know how to change the codes below
from hard code array to dynamic array to take any number of excel
workbooks ( ie it will increase from time to time ) from a folder and
later to run data consolidation

Sub DataConsol()

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Const MAXBOOK As Long = 5
Dim i%, SheetArg$()
Dim sPath1 As String
ReDim SheetArg(1 To MAXBOOK)
Dim sPath As String, sFile As String

Windows("Data Consol.xls").Activate
ThisWorkbook.Worksheets("Sum").Cells.ClearContents
sPath = "C:\Bgt\AF\BA\mic4\"
i = 0
sPath1 = "C:\Bgt\AF\BA\mic4\*.xls"
sFile = Dir(sPath1, vbNormal)
Do While sFile <> ""
i = i + 1
SheetArg(i) = "'" & sPath & "[" & sFile & "]P+L'!R6C2:R47C15 "
sFile = Dir()
Loop


ThisWorkbook.Sheets("Sum").Range("A1").Consolidate _
Sources:=Array(SheetArg), Function:=xlSum, TopRow:=True, _
LeftColumn:=True, CreateLinks:=True

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

Any helps on the above will be appreciated as I'm beginner to excel
vba

Thanks & Regards
Len

 

[Bob Phillips]

Sub DataConsol()
Const MAXBOOK As Long = 5
Dim i%, SheetArg$()
Dim sPath1 As String
Dim sPath As String, sFile As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Windows("Data Consol.xls").Activate
ThisWorkbook.Worksheets("Sum").Cells.ClearContents
sPath = "C:\Bgt\AF\BA\mic4\"
i = 0
sPath1 = "C:\Bgt\AF\BA\mic4\*.xls"
sFile = Dir(sPath1, vbNormal)

ReDim SheetArg(1 To 1)
Do While sFile <> ""
i = i + 1
ReDim Preserve SheetArg(1 To i)
SheetArg(i) = "'" & sPath & "[" & sFile & "]P+L'!R6C2:R47C15 "
sFile = Dir()
Loop

ThisWorkbook.Sheets("Sum").Range("A1").Consolidate _
Sources:=Array(SheetArg), Function:=xlSum, TopRow:=True, _
LeftColumn:=True, CreateLinks:=True

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

HTH

Bob

 

[Len]

Hi Bob,

Thanks a lot for your response and your codes
Great!...... it works

Regards
Len