Bonjour à tous,
Un essai par macro....
Sub test()
Dim tn, ntb, i%, j%, k%, x%
With Sheets("Feuil1")
tb = .Range("B2").CurrentRegion
k = 0
ReDim ntb(0 To UBound(tb, 1) * 2, 1 To 5)
For i = 2 To UBound(tb, 1)
For x = 5 To 6
If tb(i, x) <> "" Then
For j = 1 To 4
ntb(k, j) = tb(i, j): Next j
ntb(k, 5) = tb(i, x): k = k + 1
End If
Next x
Next i
End With
With Sheets("Feuil2")
If k > 0 Then
.Range("B2").CurrentRegion.Offset(1, 0).ClearContents
.Range("B3").Resize(k, 5) = ntb
.Activate
Erase tb: Erase ntb
End If
End With
End Sub
Cordialement,