Sub transfo1()
Dim i As Long, L As Long
Dim C As Integer
tbl = Sheets("L1").Range("A1").CurrentRegion
Application.ScreenUpdating = False
With Sheets("BDD2")
L = .Range("A65536").End(xlUp).Row + 1
.Range("A2:E" & L).ClearContents 'efface
For i = 2 To UBound(tbl, 1) 'lignes
For C = 4 To UBound(tbl, 2) Step 2 'colonnes
If tbl(i, C) = "" Then Exit For
L = .Range("A65536").End(xlUp).Row + 1
.Range("A" & L).Value = tbl(i, 1) 'transport
.Range("B" & L).Value = tbl(i, 2) 'dépôt
.Range("C" & L).Value = tbl(i, 3) 'dpt
.Range("D" & L).Value = tbl(i, C) 'p
.Range("E" & L).Value = tbl(i, C + 1) 'm
Next C
Next i
End With
Application.ScreenUpdating = True
End Sub