I made a slight change:
Sub Import_Data()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim x As Integer
Dim lcol, lrow As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Worksheets
ws.Calculate
Next ws
MsgBox ("1. Please select the LATEST time period file.")
FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & import range", Filefilter:="Excel Files(.xls),xls")
If FileToOpen <> False Then
ThisWorkbook.Worksheets(10).Range(Cells(1, 9), Cells(Rows.Count, Columns.Count)).EntireColumn.Delete
ThisWorkbook.Worksheets("Temp.Sheet").Cells.Clear
Set OpenBook = Application.Workbooks.Open(FileToOpen)
With OpenBook
For Each ws In Worksheets
With ws
lr = ThisWorkbook.Worksheets("Temp.Sheet").Cells(Rows.Count, 1).End(xlUp).Row
lcol = .Cells(7, .Columns.Count).End(xlToLeft).Column
lrow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(7, 1), .Cells(lrow, lcol)).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=ThisWorkbook.Worksheets(10).Range("C25:G27"), Copytorange:=ThisWorkbook.Worksheets("Temp.Sheet").Range("A" & lr + 1), Unique:=False
End With
Next ws
End With
OpenBook.Close False
Else
Exit Sub
End If
If WorksheetFunction.CountA(Sheets("Temp.Sheet").Range("A8:XFD18")) = 0 Then
Sheet10.Range(Cells(1, 9), Cells(Rows.Count, Columns.Count)).EntireColumn.Delete
MsgBox ("No data found as per the criteria.")
Exit Sub
End If
End Sub
Bookmarks