Sub Bouton5_QuandClic()
Dim tablo()
Dim i As Byte, j As Byte, x As Byte
Dim derligne As Byte
x = 1
For i = 3 To Cells(1, 256).End(xlToLeft).Column
derligne = Cells(65536, i).End(xlUp).Row
For j = 2 To derligne
If Cells(j, i) <> '' Then
ReDim Preserve tablo(1 To 4, 1 To x)
tablo(1, x) = Cells(1, i)
tablo(2, x) = Cells(j, 1)
tablo(3, x) = Cells(j, 2)
tablo(4, x) = Cells(j, i)
x = x + 1
End If
Next j
Next i
Sheets('feuil2').Range('a1').Resize(UBound(tablo, 2), UBound(tablo, 1)) = WorksheetFunction.Transpose(tablo)
End Sub