Sélection selon motif de la cellule

Sub Effacer()
Dim coul&, tablo, ncol%, i&, j%
coul = 19 'code couleur à adapter
With ActiveSheet.UsedRange
    tablo = .Resize(.Rows.Count + 1).Formula 'matrice, plus rapide, au moins 2 éléments
    ncol = UBound(tablo, 2)
    For i = 1 To UBound(tablo) - 1
        For j = 1 To ncol
            If .Cells(i, j).Interior.ColorIndex <> coul Then tablo(i, j) = ""
    Next j, i
    If .Parent.FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Formula = tablo 'restitution
End With
End Sub

Sub Effacer2()
Dim coul&, tablo, ncol%, i&, j%
coul = 19 'code couleur à adapter
With ActiveSheet.UsedRange
    tablo = .Resize(.Rows.Count + 1).Formula 'matrice, plus rapide, au moins 2 éléments
    ncol = UBound(tablo, 2)
    For i = 1 To UBound(tablo) - 1
        For j = 1 To ncol
            If .Cells(i, j).Interior.ColorIndex <> coul Then tablo(i, j) = "" Else If tablo(i, j) = "" Then tablo(i, j) = " "
    Next j, i
    If .Parent.FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Formula = tablo 'restitution
    On Error Resume Next 'si aucune SpecialCell
    .SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = xlNone 'efface les couleurs des cellules vides
    .Replace " ", "", xlWhole 'efface l'espace
End With
End Sub