I have assumed that the data to be transposed starts in cell A2 and that there is actually more than one row of it, try this in a copy of your workbook.
Code:
Sub Rearrange()
Dim a As Variant, b As Variant
Dim i As Long, j As Long, k As Long, uba2 As Long
a = Range("A2", Range("A2").End(xlDown)).Resize(, Cells(2, Columns.Count).End(xlToLeft).Column).Value
uba2 = UBound(a, 2)
ReDim b(1 To UBound(a) * (uba2 - 2), 1 To 3)
For i = 1 To UBound(a)
For j = 3 To uba2
k = k + 1
b(k, 1) = a(i, 1): b(k, 2) = a(i, 2): b(k, 3) = a(i, j)
Next j
Next i
Range("A" & Rows.Count).End(xlUp).Offset(2).Resize(UBound(b), 3).Value = b
End Sub
An alternative is to use Power Query which is include in 2016 and 365. If you have an earlier version of Excel, you may download from MS for free.
In PQ, add your table using Get and Transform. Highlight the three columns you wish to transform and right click and then Unpivot. This will generate the expected results.
We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel
Which adblocker are you using?
Disable AdBlock
Follow these easy steps to disable AdBlock
1)Click on the icon in the browser’s toolbar. 2)Click on the icon in the browser’s toolbar. 2)Click on the "Pause on this site" option.
Go back
Disable AdBlock Plus
Follow these easy steps to disable AdBlock Plus
1)Click on the icon in the browser’s toolbar. 2)Click on the toggle to disable it for "mrexcel.com".
Go back
Disable uBlock Origin
Follow these easy steps to disable uBlock Origin
1)Click on the icon in the browser’s toolbar. 2)Click on the "Power" button. 3)Click on the "Refresh" button.
Go back
Disable uBlock
Follow these easy steps to disable uBlock
1)Click on the icon in the browser’s toolbar. 2)Click on the "Power" button. 3)Click on the "Refresh" button.