Sub Test2()
Dim TE(), LE&, CE&, TS(), LS&, CS&, TLC&()
TE = Feuil2.UsedRange.Value
ReDim TS(1 To UBound(TE, 1) \ 3 + 1, 1 To UBound(TE, 2) * 3 - 2)
ReDim TLC(1 To UBound(TS, 2))
For LE = 2 To UBound(TE, 1)
For CE = 2 To UBound(TE, 2)
Select Case TE(LE, CE)
Case "M": CS = CE * 3 - 5
Case "A": CS = CE * 3 - 4
Case "N": CS = CE * 3 - 3
Case "Pro": CS = CE * 3 - 3
Case "Pro": CS = CE * 3 - 3
Case "Pro": CS = CE * 3 - 3
Case Else: CS = 0: End Select
If CS > 0 Then
LS = TLC(CS) + 1: TLC(CS) = LS
TS(LS, CS) = TE(LE - (LE - 2) Mod 3, 1)
End If: Next CE, LE
Feuil1.[B3].Resize(UBound(TS, 1), UBound(TS, 2)).Value = TS
End Sub