Option Explicit
Sub EbaucheBase()
Dim TDon(), TRés(), LD&, CD&, LR&
TDon = Feuil1.[B27:P37].Value
ReDim TRés(1 To 1000, 1 To 3)
For CD = 1 To UBound(TDon, 2)
For LD = 3 To UBound(TDon, 1)
If TDon(LD, CD) <> "" Then
LR = LR + 1
TRés(LR, 1) = TDon(1, CD)
TRés(LR, 2) = TDon(2, CD)
TRés(LR, 3) = TDon(LD, CD)
End If: Next LD, CD
Feuil3.[B3].Resize(LR, 3).Value = TRés
End Sub