Transpose Columns To Rows (with Variable Columns)

Based on you removing the blank row at the top so your table sits at A1, and remove all the other stuff except the data... try this:

Option Explicit

Sub ReformatTable()
Dim LR As Long

Application.ScreenUpdating = False
Range("H1:P1").Value = [{"ProdCode","Description","Description","Description","Value1","Value1","Value1","Value2","Value2","Value2"}]

Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Range("G1"), Unique:=True
    
LR = Range("G" & Rows.Count).End(xlUp).Row

Range("H2:J" & LR).FormulaR1C1 = _
        "=IF(COUNTIF(C1, RC7) >= COLUMN(R1C[-7]), INDEX(C2, MATCH(RC7,C1, 0) + COLUMN(R1C[-7])-1), """")"
Range("K2:M" & LR).FormulaR1C1 = _
        "=IF(COUNTIF(C1, RC7) >= COLUMN(R1C[-10]), INDEX(C3, MATCH(RC7,C1, 0) + COLUMN(R1C[-10])-1), """")"
Range("N2:P" & LR).FormulaR1C1 = _
        "=IF(COUNTIF(C1, RC7) >= COLUMN(R1C[-13]), INDEX(C4, MATCH(RC7,C1, 0) + COLUMN(R1C[-13])-1), """")"

With Range("H2:P" & LR)
    .Value = .Value
    .Borders.Weight = xlThin
End With

Range("A1").Copy
Range("H1:P1").PasteSpecial xlPasteFormats
Range("H:P").Columns.AutoFit

Application.CutCopyMode = False

Application.ScreenUpdating = True
End Sub

The macro operates on the assumption that the 1-3 matching rows per code will be together in the list, as shown in your example.