Bonjour,
A essayer :
Sub Réorganiser()
Dim T1(), T2(), T3(), T4(), k, T, n%, i%, i1%, i2%, i3%, i4%
With Worksheets("Saisie")
n = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("A6:C" & n).Sort key1:=.Range("A6"), order1:=xlAscending, Header:=xlNo
For i = 6 To n
Select Case UCase(.Cells(i, 2))
Case "MER MAT"
i1 = i1 + 1: ReDim Preserve T1(1, i1 - 1)
T1(0, i1 - 1) = .Cells(i, 1): T1(1, i1 - 1) = .Cells(i, 3)
Case "MER AP"
i2 = i2 + 1: ReDim Preserve T2(1, i2 - 1)
T2(0, i2 - 1) = .Cells(i, 1): T2(1, i2 - 1) = .Cells(i, 3)
Case "JEU MAT"
i3 = i3 + 1: ReDim Preserve T3(1, i3 - 1)
T3(0, i3 - 1) = .Cells(i, 1): T3(1, i3 - 1) = .Cells(i, 3)
Case "JEU AP"
i4 = i4 + 1: ReDim Preserve T4(1, i4 - 1)
T4(0, i4 - 1) = .Cells(i, 1): T4(1, i4 - 1) = .Cells(i, 3)
End Select
Next i
End With
k = Array(i1, i2, i3, i4)
T = Array(T1, T2, T3, T4)
With Worksheets("Tri")
For i = 2 To 14 Step 4
n = .Cells(.Rows.Count, i).End(xlUp).Row
If n > 5 Then .Range(.Cells(6, i), .Cells(n, i + 2)).ClearContents
.Cells(6, i).Resize(k(i \ 4), 2).Value = WorksheetFunction.Transpose(T(i \ 4))
Next i
End With
End Sub
Cordialement.