With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim Myfile As String
Dim erow As Long
Dim LastRow As Long
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim test() As String
Dim total As Long
On Error GoTo ERRORHANDLER
Sheets("Menu").Activate
Myfile = Dir(Filepath & "\*.xlsx", vbArchive)
Set wb1 = ActiveWorkbook
test = sortedfiles(Filepath & "\*.xlsx")
For ii = 1 To UBound(test)
If test(ii) <> ThisWorkbook.Name Then
Workbooks.Open (Filepath & "\" & test(ii))
End If
Set wb2 = ActiveWorkbook
wb2.Save
LastRow = ActiveWorkbook.ActiveSheet.Cells(Rows.count, "A").End(xlUp).Row - 1
ActiveSheet.Range("A3:H" & LastRow).Copy
wb1.Activate
Sheets("Master Summary Table").Activate
erow = ActiveWorkbook.ActiveSheet.Cells(Rows.count, "A").End(xlUp).Row + 1
ActiveSheet.Range("A" & erow).Select
If erow <> 3 And ActiveCell.Interior.Color = vbWhite Then
Range("A" & erow, "H" & erow).Interior.Color = vbBlack
ActiveCell.Offset(1, 0).Select
End If
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
wb2.Close savechanges:=False
Next ii
.....