Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, j%, k%, x$
tablo = Feuil1.[A1].CurrentRegion.Resize(, 182) '182 = 2 + 15 x 12
ReDim resu(1 To UBound(tablo), 1 To 14) '14 = 2 + 1 x 12)
For i = 2 To UBound(tablo)
resu(i - 1, 1) = tablo(i, 1): resu(i - 1, 2) = tablo(i, 2)
For j = 3 To 182 Step 12
If tablo(i, j) <> "" Then
For k = 0 To 11
x = resu(i - 1, 3 + k)
resu(i - 1, 3 + k) = IIf(x = "", "", x & vbLf) & tablo(i, j + k)
Next
End If
Next j, i
'---restitution---
If i > 2 Then [A2].Resize(i - 2, 14) = resu
Rows(i & ":" & Rows.Count).Delete 'RAZ en dessous
End Sub