Sub Macro2()
Dim tablo, i&, n&, j%
With ActiveSheet.UsedRange
tablo = .Formula 'matrice, plus rapide
ncol = UBound(tablo, 2)
For i = 1 To UBound(tablo)
If Application.CountA(.Rows(i)) And .Rows(i).Interior.ColorIndex <> xlNone Then
n = n + 1
For j = 1 To ncol: tablo(n, j) = tablo(i, j): Next
End If
Next
.Formula = "" 'RAZ
.Interior.ColorIndex = xlNone 'RAZ
If n Then
.Resize(n).Interior.ColorIndex = xlNone 'RAZ
.Resize(n).Formula = tablo
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1).Delete xlUp 'RAZ en dessous
End With
With ActiveSheet.UsedRange: End With 'actualise la barre de défilement verticale
End Sub