Sub MAMACRO1()
Dim TablIni, DerLig As Long, i As Long, x As Long
Dim TabFin(), TabTemp()
With Worksheets("macro 1") ' à adapter
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
TablIni = .Range("A1:N" & DerLig)
End With
For i = LBound(TablIni) To UBound(TablIni)
If TablIni(i, 8) <> "" Then
x = x + 1
ReDim Preserve TabFin(1 To 8, 1 To x)
TabFin(1, x) = TablIni(i, 8)
TabFin(2, x) = TablIni(i, 13)
TabFin(3, x) = TablIni(i + 6, 7)
If TablIni(i + 6, 11) <> "" Then
If TablIni(i + 4, 11) Like "*8*" Then TabFin(4, x) = TablIni(i + 6, 11)
If TablIni(i + 4, 11) Like "*22*" Then TabFin(6, x) = TablIni(i + 6, 11)
If TablIni(i + 4, 11) Like "*45*" Then TabFin(8, x) = TablIni(i + 6, 11)
End If
If TablIni(i + 6, 14) <> "" Then
If TablIni(i + 4, 14) Like "*16*" Then TabFin(5, x) = TablIni(i + 6, 14)
If TablIni(i + 4, 14) Like "*30*" Then TabFin(7, x) = TablIni(i + 6, 14)
End If
i = i + 6
End If
Next
TabFin = Application.Transpose(TabFin)
Call Tri(TabFin(), 1, LBound(TabFin, 1), UBound(TabFin, 1))
x = 0
For i = LBound(TabFin) To UBound(TabFin) Step 3
x = x + 1
TabFin(x, 1) = TabFin(i, 1)
TabFin(x, 2) = TabFin(i, 2)
TabFin(x, 3) = TabFin(i, 3)
TabFin(x, 4) = TabFin(i, 4) & TabFin(i + 1, 4) & TabFin(i + 2, 4)
TabFin(x, 5) = TabFin(i, 5) & TabFin(i + 1, 5) & TabFin(i + 2, 5)
TabFin(x, 6) = TabFin(i, 6) & TabFin(i + 1, 6) & TabFin(i + 2, 6)
TabFin(x, 7) = TabFin(i, 7) & TabFin(i + 1, 7) & TabFin(i + 2, 7)
TabFin(x, 8) = TabFin(i, 8) & TabFin(i + 1, 8) & TabFin(i + 2, 8)
Next
Worksheets("Feuil2").Range("B2").Resize(x, UBound(TabFin, 2)) = TabFin
End Sub