Cellen naargelang kleur kopieren naar ander blad

[CD007]

Ik heb 10 kolommen (A1:J50) met in elke kolom enkele gekleurde cellen.

Nu zou ik deze willen opsplitsen
De waarde van de gekleurde cellen (A1:J50) in nieuw blad
De waarde van de niet-gekleurde cellen (A1:J50) in een nieuw blad.
De opgehaalde waarden onder elkaar plaatsen in de nieuwe sheets.


Kan iemand hier een handje toesteken ?

mvg

 

[Warme bakkertje]

Zijn de cellen handmatig gekleurd of met VW. Plaats eens een voorbeeldbestand wat je situatie weergeeft zodat we iets hebben om mee te werken.

 

[CD007]

Bijlage

Hopelijk is dit bestandje duidelijk genoeg.
Bekijk bijlage voorbeeld1.xlsx

 

[Warme bakkertje]

Sub tst()
    For i = 1 To Blad1.Cells(1).CurrentRegion.Columns.Count
        For ii = 1 To Blad1.Cells(1).CurrentRegion.Rows.Count
            If Blad1.Cells(ii, i).Interior.ColorIndex = 6 Then
                sn = sn & Blad1.Cells(ii, i).Value & "|": x = x + 1
            Else
                sn2 = sn2 & Blad1.Cells(ii, i).Value & "|": x1 = x1 + 1
            End If
        Next
    Next
    Blad2.Cells(1).Resize(x) = Application.Transpose(Split(sn, "|"))
    Blad3.Cells(1).Resize(x1) = Application.Transpose(Split(sn2, "|"))
End Sub

 

[CD007]

UITSTEKEND !

Waarvoor dank
... ik sta altijd versteld van met welk gemak er soms oplossingen worden aangereikt.