Sub Essai()
Dim TDon(), LD As Long, TRés(), LR As Long, C As Integer
TDon = Feuil1.[D5:I9].Value
ReDim TRés(1 To UBound(TDon, 1) * (UBound(TDon, 2) - 1), 1 To 2)
For LD = 1 To UBound(TDon, 1)
For C = 2 To UBound(TDon, 2)
If TDon(LD, C) <> "" Then
LR = LR + 1
TRés(LR, 1) = TDon(LD, 1)
TRés(LR, 2) = TDon(LD, C)
End If: Next C, LD
Feuil1.[L4].Resize(UBound(TRés, 1), 2).Value = TRés
End Sub