Hi all,

I have consolidation workbook, which got below code.
This consolidates data from multiple excel file to consolidation work book.

The challenges are as follows,
1) Code is collating data very slowly, for 40 files it takes around 5 minutes
2) If the Number of files is more in the folder path, then the consolidation workbook force closes.

I think code is not efficient enough.

Could someone look into the code and feel free to edit it please.


Sub macc()

Dim wbk As Workbook
Dim wbk1 As Workbook
Set wbk1 = ThisWorkbook
Dim Filename As String
Dim path As String

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

path = ThisWorkbook.Worksheets(1).Range("Ah2").Value ' File path given in Cell value
Filename = Dir(path & "*.xlsb")
''''''''''''



Do While Filename <> ""

On Error GoTo 0
On Error GoTo ERRHANDLER


Set wbk = Workbooks.Open(path & Filename, ReadOnly = True)

wbk.Activate
Worksheets(1).Activate
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Daily & MTD Productivity Summary.xlsm").Activate ' This is the file where this code is present
Application.DisplayAlerts = False

Dim lr As Double
lr = wbk1.Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("sheet1").Select
Cells(lr + 1, 1).Select
ActiveSheet.Paste
        

wbk.Activate
Worksheets(2).Activate
If Range("A2").Value <> "" Then
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Daily & MTD Productivity Summary.xlsm").Activate
Application.DisplayAlerts = False
Dim lar As Double
lar = wbk1.Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("sheet2").Select
Cells(lar + 1, 1).Select
ActiveSheet.Paste
        
Application.CutCopyMode = False
wbk.Close False
Else
wbk.Close False
End If



'wbk.Close False
Filename = Dir
Loop



ERRHANDLER:
Application.DisplayAlerts = False


Worksheets(1).Activate
Range("A6:AC6").AutoFilter
    ActiveSheet.Range("$A$6:$AC$309").AutoFilter Field:=2, Criteria1:="Work Date", Operator:=xlOr, Criteria2:="="
    'ActiveSheet.Range("$A$6:$AC$309").AutoFilter Field:=2, Criteria2:=""
    Rows("7:7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("A6").Select
    Range("A6:AC6").AutoFilter
    
    
    Worksheets(2).Activate
Range("A1:M1").AutoFilter
    ActiveSheet.Range("A:M").AutoFilter Field:=2, Criteria1:="Date", Operator:=xlOr, Criteria2:="="
    'ActiveSheet.Range("$A$6:$AC$309").AutoFilter Field:=2, Criteria2:=""
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("A6").Select
    Range("A1:M1").AutoFilter
    
'    Worksheets(1).Activate

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With




End Sub