Copy yellow shaded rows to another worksheet

[andreashermle]

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

 

[James Ravenswood]

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...ilter=mf:33716c22-2433-4d9b-8ce0-047e4781dcf4

 

[andreashermle]

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/Forums/en-US/officeprog/threads?f...

Hi James,

exactly what I wanted. I works just fine.

Thank you very much for your professional help.

Regards, Andreas