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

On Jun 19, 3:08*pm, andreashermle <andreas.her...@gmx.de> 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

On Jun 19, 11:23*pm, James Ravenswood <james.ravensw...@gmail.com>
wrote:
> On Jun 19, 3:08*pm, andreashermle <andreas.her...@gmx.de> 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