Option Explicit
Sub Transpose()
Dim a, b(), i As Long, j As Long, n As Long
Application.ScreenUpdating = False
With Range("A1").CurrentRegion
a = .Value
ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1), 1 To 3)
For i = 2 To UBound(a, 1)
For j = 2 To UBound(a, 2)
n = n + 1
b(n, 1) = a(i, 1)
b(n, 2) = a(1, j)
b(n, 3) = a(i, j)
Next
Next
With .Offset(, .Columns.Count + 1).Resize(n, 3)
.CurrentRegion.Clear
.Value = b
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.HorizontalAlignment = xlCenter
End With
End With
Application.ScreenUpdating = True
End Sub