Private Sub Worksheet_Activate()
Dim mem, n&, i As Variant, h&
Application.ScreenUpdating = False
With [H1].CurrentRegion.Resize(, 18)
With .Cells(2, 1).Resize(Rows.Count - 1, 18)
.Interior.ColorIndex = xlNone 'RAZ
.Borders.LineStyle = xlNone 'RAZ
End With
mem = .Formula 'mémorisation
If Application.CountBlank(.Columns(20)) Then .Columns(20).SpecialCells(xlCellTypeBlanks) = 9
.Cells(1, 21) = 1
.Columns(21).DataSeries 'colonne auxiliaire numérotée
.Resize(, 21).Sort .Columns(20), Header:=xlYes 'tri pour regrouper les lignes
For n = 1 To Application.Max(Feuil6.Columns("AA"))
i = Application.Match(n, .Columns(20), 0)
If IsNumeric(i) Then
h = Application.CountIf(.Columns(20), n)
Feuil6.Cells(n + 1, "H").Resize(, 18).Copy .Cells(i, 1).Resize(h, 18)
End If
Next
.Resize(, 21).Sort .Columns(21), xlAscending, Header:=xlYes 'tri pour rétablir l'ordre initial
.Columns(21).ClearContents
.Formula = mem 'restitution des formules et valeurs
End With
End Sub