Tu veux dire que la "fiche" de chaque personne doit rester sur 6 lignes ?Bien sûr la mise en page de la feuille ne doit pas être modifiée.
Sub Tri_Tableau()
Dim Sh As Worksheet: Set Sh = ActiveWorkbook.Worksheets("Feuil1")
Dim Start_Row As Long: Start_Row = 11
Dim End_Row As Long: End_Row = 28
Application.ScreenUpdating = False
With Sh.Sort
.SortFields.Clear
.SortFields.Add Key:=Sh.Columns("C").Rows(Start_Row & ":" & End_Row), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Sh.Columns("D").Rows(Start_Row & ":" & End_Row), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Sh.Columns("A:T").Rows(Start_Row & ":" & End_Row)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For Each L In Sh.Columns("A:T").Rows(Start_Row & ":" & End_Row).Rows
If L.Cells(1) = "" Then
L.Columns("A:D").Borders.LineStyle = xlLineStyleNone
For Each Cell In L.Columns("E:T").Cells
Cell.BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=0
Next
Else
For Each Cell In L.Columns("A:T").Cells
Cell.BorderAround LineStyle:=xlContinuous, Weight:=xlThick, Color:=vbRed
Next
End If
Next
End Sub
Sub TestTri()
Dim der&, N&, last&, t, i&, j&, k&, aux, ech As Boolean
der = Cells(Rows.Count, "c").End(xlUp).Row
If der <= 11 Then Exit Sub
t = Range("a11:t" & 10 + 6 * (1 + Int((der - 11) / 6)))
For i = 1 To UBound(t) - 1 Step 6: t(i, 3) = t(i, 3) & "\" & t(i, 4): Next
Do
ech = False
For i = 1 To UBound(t) - 6 Step 6
If t(i, 3) > t(i + 6, 3) Then
ech = True
For k = 0 To 5
For j = 1 To UBound(t, 2)
aux = t(i + k, j): t(i + k, j) = t(i + k + 6, j): t(i + k + 6, j) = aux
Next j
Next k
End If
Next i
If Not ech Then Exit Do
Loop
For i = 1 To UBound(t) - 1 Step 6: t(i, 3) = Split(t(i, 3), "\")(0): Next
Range("a11").Resize(UBound(t), UBound(t, 2)) = t
End Sub
Re @fanch55Je n'avais pas compris qu'il y avait une notion de groupe ....