Try this...
Private Sub Picture9_Click()
Dim cell As Range
Dim wb As Workbook
Application.ScreenUpdating = False
Worksheets("Master").Range("B3:R500").ClearContents
For Each cell In Worksheets("Data").Range("A1", Worksheets("Data").Range("A" & Rows.Count).End(xlUp))
Application.StatusBar = "Opening File: " & cell.Value
Set wb = Workbooks.Open(Filename:=cell.Value, UpdateLinks:=True)
With wb.Sheets("Activity Summary")
.Range("B7:S27").AutoFilter Field:=1, Criteria1:="<>"
.Range("B8:S27").Copy
End With
ThisWorkbook.Worksheets("Master").Range("B1").End(xlDown).Offset(1). _
PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wb.Sheets("Activity Summary").Range("B7:S27").AutoFilter
wb.Close SaveChanges:=True
Next cell
Application.StatusBar = "Done"
Application.ScreenUpdating = True
End Sub
Bookmarks