Function Couleur(c As Range)
Couleur = IIf(c.Interior.ColorIndex = xlNone, "", 1)
End Function
Sub MAJ_Imputation()
Dim ncol%
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de SpecialCells
With Feuil01.[A7].CurrentRegion
.Parent.ShowAllData 'si la feuille est filtrée
With .Offset(1).Resize(.Rows.Count - 1)
ncol = .Columns.Count
.Columns(ncol + 1) = "=Couleur(RC[-1])" '1ère colonne auxiliaire
Intersect(.Columns(ncol), Columns(ncol + 1).SpecialCells(xlCellTypeFormulas, 1).EntireRow) = "" 'RAZ des cellules colorées
.Columns(ncol).Interior.ColorIndex = xlNone 'RAZ couleur
.Cells(1, ncol + 1) = 1
.Columns(ncol + 1).DataSeries '1ère colonne auxiliaire, ordre initial numéroté
.Columns(ncol + 2) = 0
Intersect(.Columns(ncol).SpecialCells(xlCellTypeBlanks).EntireRow, .Columns(ncol + 2)) = 1 '2ème colonne auxiliaire
.Resize(, ncol + 2).Sort .Columns(ncol + 2), xlAscending, Header:=xlNo 'tri sur la 2ème colonne auxiliaire
With .Columns(ncol).SpecialCells(xlCellTypeBlanks) 'cellules vides regroupées en bas de la colonne par le tri
.FormulaR1C1 = "=IF(ROW()=MATCH(RC1,C1,0),"""",INDEX(C,MATCH(RC1,C1,0)))" 'copie la 1ère occurence
.Value = .Value 'supprime les formules
.SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 6 'jaune
End With
.Resize(, ncol + 1).Sort .Columns(ncol + 1), xlAscending, Header:=xlNo 'remise en ordre initial
.Columns(ncol + 1).Resize(, 2) = "" 'RAZ des 2 colonnes auxiliaires
End With
End With
End Sub