Bonjour.
Sub Demo1()
With Feuil1.Cells(1).CurrentRegion
ReDim TR$(1 To Application.CountA(.Offset(, 1)), 1 To 2)
VA = .Value
End With
For R& = 1 To UBound(VA)
For C& = 2 To UBound(VA, 2)
If VA(R, C) > "" Then
L& = L& + 1
TR(L, 1) = VA(R, C)
TR(L, 2) = VA(R, 1)
End If
Next C
Next R
With Feuil1.Cells(18).Resize(L, 2)
.HorizontalAlignment = xlCenter
.Value = TR
.Sort .Cells(1), Header:=xlYes
End With
End Sub