Bonjour bob.dindons, bienvenue sur XLP ,
Moins simple qu'il n'y parait. Un essai qui gère :
- la modification d'une ou plusieurs cellules dans la colonne D
- les modifications peuvent être la saisie d'une ou plusieurs valeurs dans la colonne D
- les modifications peuvent être aussi l'effacement d'une ou plusieurs valeurs dans la colonne D
- On regroupe les lignes avec les valeurs de la colonne D non vides en tête de tableau puis viennent les lignes avec aucune valeur en colonne D.
- Les lignes en tête de tableau sont colorées avec un fond en gris
- Les dernières lignes avec des valeurs saisies non vides en D sont bien positionnées en haut du tableau devant les valeurs précédentes déjà présentes.
Le code est dans le module de "Feuille 1". On utilise une colonne auxiliaire. Cette colonne est précisée dans la constante Colxxx (en tête du code). Pour l'exemple, on a pris la colonne X. Modifiez cette colonne pour indiquer une colonne qui ne sera jamais utilisée par l'utilisateur.
le code :
Private Sub Worksheet_Change(ByVal Target As Range)
Const Colxxx = "X"
Dim xrg As Range, der&, colval As Range, Zonetri As Range, x, prem As Range
Set xrg = Intersect(Target, Columns("d:d"))
If xrg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Me.FilterMode Then Me.ShowAllData
der = Cells(Rows.Count, "a").End(xlUp).Row
Set colval = Range(Cells(2, Colxxx), Cells(der, Colxxx))
Set Zonetri = Range(Cells(1, 1), Cells(der, Colxxx))
If der = 1 Then Exit Sub
On Error GoTo Err01
Application.EnableEvents = False
colval.Formula = "=IF(d2="""",10^10,ROW())"
For Each x In xrg
If x <> "" Then Cells(x.Row, Colxxx) = -1
Next x
colval.Value = colval.Value
Zonetri.Sort key1:=Cells(1, Colxxx), order1:=xlAscending, Header:=xlYes
On Error Resume Next
Set prem = Columns("d:d").Find(what:="")
If Not prem Is Nothing Then If prem.Row - 1 <= der And prem.Row - 1 > 1 Then Range(Cells(2, "a"), Cells(prem.Row - 1, "g")).Interior.Color = RGB(200, 200, 200)
Err01:
colval.EntireColumn.Clear
Application.EnableEvents = True
End Sub