Add Header to Each Record As Row - excel

Question

I receive an excel file with the below format:
But I need it to be the below format:
I have the blow code but it's not working.
Sub Format_Click()
Dim ws1 As Worksheet
Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet
Set ws2 = Sheets("Sheet2")
Dim count As Integer
Dim rng As Range
Set rng = ws1.UsedRange
ws2.Cells(1, 1) = "Contract"
ws2.Cells(1, 2) = "Code"
ws2.Cells(1, 3) = "Price"
For i = 1 To rng.Columns.count
For j = 2 To rng.Rows.count
count = ws2.Range("A" & ws2.Rows.count).End(xlUp).Row
ws2.Cells(count + 1, 1) = rng.Cells(1, i)
ws2.Cells(count + 1, 2) = rng.Cells(j, i)
ws2.Cells(count + 1, 3) = rng.Cells(j, 1)
Next j
Next i
End Sub

Answer 1

Take all the data into an array, loop trough once and detect categories (categories are values with no qty according to your image).
My code shows output in same sheet but in can bee easily adapted to make output in a different worksheet:
Sub test()
Dim i As Long
Dim j As Long
Dim LR As Long
Dim MyData As Variant
Dim CurrentCat As String
LR = Range("A" & Rows.Count).End(xlUp).Row
MyData = Range("A1:B" & LR).Value
Range("D1").Value = "Category"
Range("E1").Value = "Name"
Range("F1").Value = "Qty"
j = 2
For i = LBound(MyData) To UBound(MyData) Step 1
If MyData(i, 2) = "" Then
'its a Category if there is no qty
CurrentCat = MyData(i, 1)
Else
'there is data
Range("D" & j).Value = CurrentCat
Range("E" & j).Value = MyData(i, 1)
Range("F" & j).Value = MyData(i, 2)
j = j + 1
End If
Next i
Erase MyData
End Sub
Consider reading about arrays, pretty useful:
Excel VBA Array – The Complete
Guide