Sub doItMethod1()
Dim rng As Range
Dim cll As Range
Dim cllFruit As Range
Dim rngCompany As Range
Dim rngFruit As Range
Dim rngOutput As Range
' Input range
Set rng = ActiveSheet.Range("data")
' Output range top left cell
' Start one row below the input range
Set rngOutput = rng.Offset(rng.Rows.Count + 1).Resize(1, 1)
' Company columns range
' We are going to loop through companies
' to create the desired table
' Relative to the whole data, rng,
' it starts after 2 columns (offset 2 columns)
' and 2 columns less than the entire data column length (resize -2 columns)
Set rngCompany = rng.Offset(, 2).Resize(, rng.Columns.Count - 2)
' Fruit ID range - similar to Company columns, but rows this time
Set rngFruit = rng.Offset(1).Resize(rng.Rows.Count - 1)
' Loop through company name cells - the first row of the company range
For Each cll In rngCompany.Rows(1).Cells
' Loop through fruit id cells
' and fill the output table with corresponding data
For Each cllFruit In rngFruit.Columns(1).Cells
With rngOutput
.Value = cll.Value
.Offset(, 1).Value = cllFruit.Cells(, 1).Value
.Offset(, 2).Value = cllFruit.Cells(, 2).Value
.Offset(, 3).Value = cllFruit.Cells(, cll.Column - cllFruit.Column + 1).Value
End With
' Jump to the next row
Set rngOutput = rngOutput.Offset(1)
Next cllFruit
Next cll
End Sub