Copy yellow shaded rows to another worksheet
 

Dear Experts:

The active worksheet of an excl-file has numerous rows with a yellow
fill.

I would like to have these yellow shaded rows copied automatically
(via VBA) to sheet 4 (Name of this sheet is: NoMatch) with no blank
rows in between.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Copy yellow shaded rows to another worksheet
 

On Jun 19, 3:08*pm, andreashermle wrote:
Dear Experts:

The active worksheet of an excl-file has numerous rows with a yellow
fill.

I would like to have these yellow shaded rows copied automatically
(via VBA) to sheet 4 (Name of this sheet is: NoMatch) with no blank
rows in between.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

This works with Yellow #6:

Sub MoveYellow()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = ActiveSheet
Set s2 = Sheets("NoMatch")
s2.Activate
If IsEmpty(Range("A1")) Then
i = 1
Else
i = Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
s1.Activate
j = Cells(Rows.Count, "A").End(xlUp).Row
For n = 1 To j
If Cells(n, "A").Interior.ColorIndex = 6 Then
Cells(n, "A").EntireRow.Copy s2.Cells(i, "A")
i = i + 1
End If
Next
End Sub


Another good place to post questions of this type is:

http://social.answers.microsoft.com/...0-047e4781dcf4

Copy yellow shaded rows to another worksheet
 

On Jun 19, 11:23*pm, James Ravenswood
wrote:
On Jun 19, 3:08*pm, andreashermle wrote:

Dear Experts:

The active worksheet of an excl-file has numerous rows with a yellow
fill.

I would like to have these yellow shaded rows copied automatically
(via VBA) to sheet 4 (Name of this sheet is: NoMatch) with no blank
rows in between.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

This works with Yellow #6:

Sub MoveYellow()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = ActiveSheet
Set s2 = Sheets("NoMatch")
s2.Activate
If IsEmpty(Range("A1")) Then
* * i = 1
Else
* * i = Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
s1.Activate
j = Cells(Rows.Count, "A").End(xlUp).Row
For n = 1 To j
* * If Cells(n, "A").Interior.ColorIndex = 6 Then
* * * * Cells(n, "A").EntireRow.Copy s2.Cells(i, "A")
* * i = i + 1
End If
Next
End Sub

Another good place to post questions of this type is:

http://social.answers.microsoft.com/...prog/threads?f...

Hi James,

exactly what I wanted. I works just fine.

Thank you very much for your professional help.

Regards, Andreas