Option Explicit
Sub transpose()
Dim a, b(), i As Long, j As Long, n As Long
With Sheets("Feuil1").Range("b3").CurrentRegion
a = .Value
End With
ReDim b(1 To (((UBound(a, 2) - 2) * (UBound(a, 1) - 1))) + 1, 1 To 3)
For i = 2 To UBound(a, 1)
For j = 3 To UBound(a, 2)
If Not IsEmpty(a(i, j)) Then
n = n + 1
b(n, 1) = a(i, j)
b(n, 2) = a(i, 1)
b(n, 3) = a(i, 2)
End If
Next
Next
'Restitution en "Feuil2"
With Sheets("Feuil2").Cells(1).Resize(, UBound(b, 2))
.CurrentRegion.Clear
.Value = [{"Commercial","Nom - Client","Prénom Client"}]
.Offset(1).Resize(n).Value = b
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 12
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
With .Rows(1)
.BorderAround Weight:=xlThin
.Font.Bold = True
End With
.Columns.ColumnWidth = 17
End With
.Parent.Activate
End With
End Sub