Bonjour,
Un test qui est loin d'être optimisé mais qui donne le résultat attendu :
Sub TRI()
With ActiveSheet
Set DICO = CreateObject("Scripting.Dictionary")
For COL = 0 To 2
.Cells(3, 15 + COL).FormulaR1C1 = "=IFERROR(VLOOKUP(RC14,C" & 4 * COL + 1 & ":C" & 4 * COL + 2 & ",2,FALSE),"""")"
PLAGE = .Range(Cells(3, 4 * COL + 1), Cells(.Cells(.Rows.Count, 4 * COL + 1).End(xlUp).Row, 4 * COL + 1))
For LIG = LBound(PLAGE) To UBound(PLAGE)
If PLAGE(LIG, 1) <> "" Then DICO(PLAGE(LIG, 1)) = ""
Next LIG
Next COL
.[N3].Resize(DICO.Count) = Application.Transpose(DICO.Keys)
.Range(Cells(3, 14), Cells(.Cells(.Rows.Count, 14).End(xlUp).Row, 14)).Sort Key1:=Range("N3"), Order1:=xlAscending, Header:=xlNo
With .Range(Cells(3, 15), Cells(.Cells(.Rows.Count, 14).End(xlUp).Row, 17))
.FillDown
.Copy
.PasteSpecial xlPasteValues
End With
End With
Application.CutCopyMode = False
End Sub
Bonne journée.