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