Extraire si couleurs vers plusieurs onglets

bonjour,

je souhaiterai copier les lignes qui ont une couleurs rouge vers l'onglet nommé rouge, les lignes qui ont une couleur orange vers l'onglet orange etc..

Et si possible avec une exécution "rapide", le fichier original comporte 20 000 lignes...

merci d'avance

Bonjour

Sub Répartition()
    Application.ScreenUpdating = False
    RAZ
    With Worksheets("Feuil1")
        y = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
        .Range("A3:D3") = "1"
        .Range("A3").AutoFilter
        .Range("$A$3:$D$" & y).AutoFilter Field:=1, Criteria1:=RGB(255, 0 _
            , 0), Operator:=xlFilterCellColor
        .Range("A4:D" & y).Copy Destination:=Worksheets("rouge").Cells(1, 1)
        .Range("$A$3:$D$" & y).AutoFilter Field:=1, Criteria1:=RGB(255, _
            192, 0), Operator:=xlFilterCellColor
        .Range("A4:D" & y).Copy Destination:=Worksheets("orange").Cells(1, 1)
        .Range("$A$3:$D$" & y).AutoFilter Field:=1, Criteria1:=RGB(255, _
            192, 0), Operator:=xlFilterCellColor
        .Range("A4:D" & y).Copy Destination:=Worksheets("orange").Cells(1, 1)

        .Range("$A$3:$D$" & y).AutoFilter Field:=1, Criteria1:=RGB(146, _
            208, 80), Operator:=xlFilterCellColor
        .Range("A4:D" & y).Copy Destination:=Worksheets("vert").Cells(1, 1)

        .Range("A3:D3").AutoFilter
        .Range("A3:D3").ClearContents
        .Activate
    End With
End Sub
Sub RAZ()
    Sheets(Array("orange", "vert", "rouge")).Select
    Selection.Columns("A:D").ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

End Sub

nickel merci !