Sub Trier()
Dim t1, ncol%, t2, t3(), i%, x As String, j%, k%
t1 = [B3:K4] 'matrice
ncol = UBound(t1, 2)
t2 = [O3].Resize(ncol) 'matrice
ReDim t3(1 To ncol, 1 To ncol)
For i = 1 To ncol
x = t2(i, 1): j = 0
For k = 1 To ncol
If t1(2, k) = x Then j = j + 1: t3(i, j) = t1(1, k)
Next
Next
'---restitution---
[Q3].Resize(ncol, ncol) = t3
End Sub