Sub combinesheets()

First = True

For Each Sht In ThisWorkbook.Sheets
If First = True Then
'create new summary worksheet
Set SummarySht = Worksheets.Add(after:=Sheets(Sheets.Count))
'copy header Row to new sheet
Sht.Rows(1).Copy Destination = SummarySht.Rows(1)
NewRow = 2
First = False
End If
LastCol = Sht.Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
AddedRow = False
For ColCount = 2 To LastCol
If Sht.Cells(RowCount, ColCount) = "" Or _
Sht.Cells(RowCount, ColCount). _
Interior.ColorIndex < xlNone Then

If AddedRow = False Then
'add header column
SummarySht.Range("A" & NewRow).Value = _
Sht.Range("A" & RowCount).Value
AddedRow = True
End If
If Sht.Cells(RowCount, ColCount) = "" Then
'Add X for empty cells
SummarySht.Cells(NewRow, ColCount) = "X"
Else
NewSht.Cells(RowCount, ColCount).Copy _
Destination:=SummarySht.Cells(NewRow, ColCount)
End If
End If
Next ColCount
If AddedRow = True Then
AddedRow = AddedRow + 1
End If
Next RowCount
Next Sht

End Sub


"leimst" wrote:

I have a workbook with 10 worksheets (tabs) each with a Header Row with the
month of July dates across the top and a Header Column with other
information running down the side. What macro would search all 10 sheets
for the last date (column) that might have an entry from any of the rows,
search back from there through July 1st and identify all blank cells or
cells with a red "fill" and consolidate all of them on a new worksheet?

Thanks for any help,

Brian