Sub test()
Dim a, i As Long, j As Long, b(), n As Long
a = Sheets("Feuil1").Range("b4").CurrentRegion.Value
ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 3)
For j = 2 To UBound(a, 2)
For i = 2 To UBound(a, 1)
If Not IsEmpty(a(i, j)) Then
n = n + 1
b(n, 1) = a(1, j)
b(n, 2) = a(i, 1)
b(n, 3) = a(i, j)
End If
Next
Next
'Restitution
With Sheets("Feuil2").Cells(1).Resize(n, 3)
.CurrentRegion.ClearContents
.Value = b
End With
End Sub