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
Bookmarks