Kopiëren obv kleur

[jorisg]

Zie bijlage.

Op tabblad 1 staat een lijst met gegevens in zes kolommens. De cellen in de eerste kolom hebben een rode of blauwe kleur.
Nu wil ik dat de gegevens per kleur naar een verschillend tabblad worden gekopieerd waarbij alleen Kolom1, 4 en 6 overgenomen worden.
Als op het eerste tabblad regels worden toegevoegd moeten deze ook weer gekopieerd worden naar het tweede en derde tabblad afhankelijk van de kleur.
Wie kan mij helpen?

Hoor het graag.

Groet Joris,

 

[HSV]

Test het maar eens.

Sub hsv()
Dim i As Long, sRng As Range, kleur As String, Tb As Range
With Sheets("Totaal")
For i = 1 To 2
If i = 1 Then kleur = RGB(0, 176, 240) Else kleur = RGB(255, 0, 0)
Set sRng = .Range("A1:F" & .Cells(Rows.Count, 1).End(xlUp).Row)
 sRng.AutoFilter 1, kleur, xlFilterCellColor
    With .AutoFilter.Range.Offset(1)
     Set Tb = Union(.Columns(1), .Columns(4), .Columns(6))
       Tb.Copy Sheets(i + 1).Range("A1")
    End With
 sRng.AutoFilter
    Next i
 End With
End Sub

 

[jorisg]

Beste Harry,

In één keer raak.
Te gek, dank je.

Groet Joris.