Hi,
How about another solution with this code.
Sub CopyOpenToSummary()
Dim LastRow As Double
Dim ShtCtr As Double
Dim RowCtr As Double
Dim LastShtRow As Double
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range(Cells(4, "A"), Cells(LastRow, "J")).ClearContents
For ShtCtr = 1 To Worksheets.Count
If Worksheets(ShtCtr).Name <> "Action Summary" Then
With Worksheets(ShtCtr)
LastShtRow = .Cells(Rows.Count, "A").End(xlUp).Row
For RowCtr = 2 To LastShtRow
If .Cells(RowCtr, "I") = "OPEN" Then
LastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(LastRow, "A") = Worksheets(ShtCtr).Name
.Range(.Cells(RowCtr, "A"), .Cells(RowCtr, "I")).Copy _
Destination:=Range(Cells(LastRow, "B"), Cells(LastRow, "J"))
End If
Next RowCtr
End With
End If
Next ShtCtr
End Sub
Bookmarks