Hi,

I get the following error ...

"Object required (Error 424)"

Its on the following line.

LastCol = .Cells(RowCount.Columns.Count).End(xlToLeft).Colum n

Sub test()

NewRow = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row

For Each Sht In Sheets
If Sht.Name < "Summary" Then
With Sht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

For RowCount = 1 To LastRow
If .Range("A" & RowCount).Interior.ColorIndex = 15 Or _
.Range("A" & RowCount).Interior.ColorIndex = 15 Then

LastCol = .Cells(RowCount.Columns.Count).End(xlToLeft).Colum n
Sheets("Summary").Range("A" & NewRow) = .Name
.Range(.Range("A" & RowCount), .Cells(RowCount,
LastCol)).Copy _
Destination:=Sheets("Summary").Range("B" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
End If
Next Sht

End Sub

Thanks