Sub Classement()
Dim P1 As Range, P2 As Range, d As Object, i&, j As Variant, h&, k As Byte
Application.ScreenUpdating = False
Set P1 = Range("B4:D" & Range("B" & Rows.Count).End(xlUp).Row)
Set P2 = [K4].Resize(Rows.Count - 3, Columns.Count - 10)
P2.Clear 'RAZ
'---détermination des en-têtes de colonnes---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To P1.Rows.Count
d(P1(i, 1).Value) = ""
Next
P2(1, 2).Resize(, d.Count) = d.keys
P2(1, 2).Resize(, d.Count).Sort P2(1, 2), Orientation:=xlLeftToRight
'---création du tableau brut---
For i = 1 To P1.Rows.Count
P2(i + 1, 1) = P1(i, 2)
j = Application.Match(P1(i, 1), P2.Rows(1), 0)
If IsNumeric(j) Then P2(i + 1, j) = P1(i, 3)
Next
P2.Sort P2(1), Header:=xlYes, Orientation:=xlTopToBottom
'---tri de chaque colonne---
For i = 2 To P1.Rows.Count + 1
If P2(i, 1) <> "" And P2(i, 1) <> P2(i - 1, 1) Then
h = Application.CountIf(P2.Columns(1), P2(i, 1))
If h > 1 Then
For j = 2 To d.Count + 1
P2(i, j).Resize(h).Sort P2(i, j), Header:=xlNo
Next
End If
End If
Next
'---suppression des lignes vides---
For i = P1.Rows.Count + 1 To 2 Step -1
If Application.CountA(P2.Rows(i)) < 2 Then P2.Rows(i).Delete xlUp
Next
'--- mise en forme, fusion et bordures---
Application.DisplayAlerts = False
P2(1, 2).Resize(, d.Count).Borders.Weight = xlThin
P2(1, 2).Resize(, d.Count).HorizontalAlignment = xlCenter
For i = 2 To P1.Rows.Count
If P2(i, 1) <> "" And P2(i, 1) <> P2(i - 1, 1) Then
h = Application.CountIf(P2.Columns(1), P2(i, 1))
P2(i, 1).Resize(h).Merge
P2(i, 1).VerticalAlignment = xlCenter
P2(i, 1).HorizontalAlignment = xlCenter
For j = 1 To d.Count + 1
For k = 7 To 10
P2(i, j).Resize(h).Borders(k).Weight = xlThin
Next
Next
End If
Next
End Sub