[Henrik Bonde (3400)]

Hi
I've got a workbook with 12 sheets, containing both old an new data.
The old data is in red font, the new in blue.
A sheet could contain maybe 200 - 300 rows with red font, and 0 -
maybe 20 in blue.

Is it possible to make a macro, that would copy/collect all the blue
rows in all 12 sheets into an emty sheet, leaveing the copied rows
red, in the original sheets?

Best regards
Henrik Bonde

Btw. Don't hit the emailreplybutton.
My header replyaddress don't work
Reply to group :-)

[Don P]

Henrik,

These assumption must be true about the data:

1. Sheet1 has no data and is the sheet that will collect the blue data
rows.
2. The entire row of blue data in each sheet is colored blue and the row
starts in column A of each sheet.
3. there are no blanks in your blue data rows.


Code could use some polishing, but it works:

Sub test()
Dim rng As Range
For Each sht In Sheets
Set rng = Nothing
If sht.Name < "Sheet1" Then
sht.Select
ActiveSheet.UsedRange.Select
For Each cell In Selection
If (cell.Font.ColorIndex = 5) Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next cell
If Not rng Is Nothing Then
rng.Select
End If
rng.EntireRow.Copy
Worksheets("Sheet1").Select
Range("A1").Select
If ActiveCell.End(xlDown).Row = Rows.Count Then ActiveCell.Select: GoTo
10
ActiveCell.End(xlDown).Offset(1, 0).Select
10 ActiveSheet.Paste
Else
End If
Next sht
End Sub

If you want a sample of the code in a file, e-mail me.
Don Pistulka




"Henrik Bonde (3400)" wrote in message
...
Hi
I've got a workbook with 12 sheets, containing both old an new data.
The old data is in red font, the new in blue.
A sheet could contain maybe 200 - 300 rows with red font, and 0 -
maybe 20 in blue.

Is it possible to make a macro, that would copy/collect all the blue
rows in all 12 sheets into an emty sheet, leaveing the copied rows
red, in the original sheets?

Best regards
Henrik Bonde

Btw. Don't hit the emailreplybutton.
My header replyaddress don't work
Reply to group :-)