Private Sub Worksheet_Activate()
Dim ncol%, tablo, resu(), i&, n&, a, b, c, d, x$, j%
With Sheets("Feuil1").[A1].CurrentRegion
.Sort .Columns(2), xlAscending, .Columns(9), , xlAscending, Header:=xlYes 'tri sur 2 colonnes
ncol = IIf(.Columns.Count < 9, 9, .Columns.Count)
tablo = .Resize(, ncol) 'matrice, plus rapide
End With
ReDim resu(1 To 2 * UBound(tablo), 1 To ncol)
For i = 2 To UBound(tablo)
If i > 2 And tablo(i, 2) <> tablo(i - 1, 2) Then
n = n + 1 'ligne de séparation
a = 0: b = 0: c = 0: d = 0
End If
x = LCase(tablo(i, 9))
If x = "classe1" Then If a < 2 Then a = a + 1: GoTo 1
If x = "classe2" Then If b < 3 Then b = b + 1: GoTo 1
If x = "classe3" Then If c < 1 Then c = c + 1: GoTo 1
If x = "classe4" Then If d < 4 Then d = d + 1: GoTo 1
GoTo 2
1 n = n + 1
For j = 1 To ncol
resu(n, j) = tablo(i, j)
Next j
2 Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
If n Then .Resize(n, ncol) = resu
.Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
.EntireColumn.Offset(, ncol).Resize(Columns.Count - ncol - .Column).ClearContents 'RAZ à droite
End With
Columns.AutoFit 'ajustement largeurs
With UsedRange: End With 'actualise les barres de défilement
End Sub