Sub Classer()
Dim P As Range, h&
Application.ScreenUpdating = False
[H:M].Clear 'RAZ
Set P = Intersect(Range("A3:F" & Rows.Count), ActiveSheet.UsedRange)
If P Is Nothing Then Exit Sub
h = P.Rows.Count
P.Columns(1).Resize(, 2).Copy [H3] 'copier-coller
P.Columns(3).Resize(, 2).Copy [H3].Offset(h)
P.Columns(5).Resize(, 2).Copy [H3].Offset(2 * h)
[H3].Resize(3 * h, 2).Sort [I3], xlDescending, [H3], , xlAscending, Header:=xlNo 'tri
[H3].Offset(h).Resize(h, 2).Cut [J3] 'couper-coller
[H3].Offset(2 * h).Resize(h, 2).Cut [L3]
End Sub