Hi Chip,

Thanks for your codes and it works fine independently
However, if I were to incorporate and modify your codes to run data
consolidation,
it fails and stops at mid line of codes with run time error "
Subscript out of range "
as indicated below

Sub Totals()

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

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

Dim sPath As String, sFile As String
Windows("Budget Consol.xls").Activate
ThisWorkbook.Worksheets("Sheet2").Cells.ClearConte nts
sPath = "M:\Help\LO\Budget\Budget Actual\Academic3\"
i = 0
sPath1 = "M:\Help\LO\Budget\Budget Actual\Academic3\*.xls"
sFile = Dir(sPath1, vbNormal)

Do While sFile < ""
i = i + 1
Dim WB As Workbook
ChDir "M:\Help\LO\Budget\Budget Actual\Academic3"
Set WB = Workbooks.Open(sFile)
WB.Worksheets("P+L").Select
Dim k As Long
Dim Lstrow As Long
Lstrow = Cells(Rows.Count, "A").End(xlUp).Row
If Lstrow 0 Then
For k = 5 To Lstrow
If Cells(k, 1).Value < "" Then
Cells(k, 1).Copy
Cells(k, 2).Select
ActiveSheet.Paste
Application.CutCopyMode = False

End If
Next
Else
MsgBox "It appears that the file is empty, check the file again"
Exit Sub
End If
WB.Close SaveChanges:=True
------------------- xxxxx Run Time Error
xxxxxxxxx---------------------------
SheetArg(i) = "'" & sPath & "[" & sFile & "]P+L'!R6C2:R47C15 "
sFile = Dir()
Loop

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

Please help up as I still unable to rectify it after debug the error

Thanks & Regards
Len