Salut Adriforest69,
un double-clic sur "Chez Carlo" pour démarrer la macro lorsque tu désires trier...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, iRow1%, iRow2%
'
Application.ScreenUpdating = False
'
If Not Intersect(Target, Range("F2:L2")) Is Nothing Then
Cancel = True
If Range("A11").Value <> "" Then
Range("AAA:AAB").Delete shift:=xlToLeft
For x = 6 To Range("A" & Rows.Count).End(xlUp).Row Step 5
For y = 1 To Range("AAB" & Rows.Count).End(xlUp).Row + IIf(Range("AAB1").Value = "", 0, 1)
If Range("AAB" & y).Value = "" Then Range("AAA" & y).Interior.Color = Range("A" & x).Interior.Color
If Range("AAA" & y).Interior.Color = Range("A" & x).Interior.Color Then Exit For
Next
Union(Range("AAB" & y), Range("R" & x)).Value = y
Next
For x = 6 To Range("A" & Rows.Count).End(xlUp).Row Step 5
For y = 11 To Range("A" & Rows.Count).End(xlUp).Row Step 5
If Range("R" & y).Value < Range("R" & y - 5).Value Then
tTab = Range("A" & y & ":R" & y + 4).FormulaLocal
Range("A" & y & ":R" & y + 4).FormulaLocal = Range("A" & y - 5 & ":R" & y - 1).FormulaLocal
Range("A" & y - 5 & ":R" & y - 1).FormulaLocal = tTab
End If
Next
Next
For x = 1 To Range("AAB" & Rows.Count).End(xlUp).Row
iRow1 = Range("R:R").Find(what:=x, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
iRow2 = Range("R:R").Find(what:=x, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
Range("A" & iRow1 & ":Q" & iRow2 + 4).Interior.Color = Range("AAA" & x).Interior.Color
If iRow1 < iRow2 Then
For y = iRow1 To iRow2 Step 5
For Z = iRow1 + 5 To iRow2 Step 5
If Range("A" & Z).Value < Range("A" & Z - 5).Value Then
tTab = Range("A" & Z & ":R" & Z + 4).FormulaLocal
Range("A" & Z & ":R" & Z + 4).FormulaLocal = Range("A" & Z - 5 & ":R" & Z - 1).FormulaLocal
Range("A" & Z - 5 & ":R" & Z - 1).FormulaLocal = tTab
End If
Next
Next
End If
Next
Range("R:R").Value = ""
Range("AAA:AAB").Delete shift:=xlToLeft
End If
End If
'
Application.ScreenUpdating = True
'
End Sub
A+