Transpose of Data

This works on your sample spreadsheet, adjust to fit if necessary

Sub transpdata()
lastrow = Worksheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
j = ""
For i = 5 To lastrow
If Worksheets("Sheet1").Cells(i, 2) <> "" Then
    k = Cells(i, 2)
    j = k
Else
    k = j
End If
l = Worksheets("Sheet1").Cells(i, 3)
m = Worksheets("Sheet1").Cells(i, 4)
shrow = WorksheetFunction.Match(k, Worksheets("Sheet1").Range("H7:H11"), False)
shcol = WorksheetFunction.Match(l, Worksheets("Sheet1").Range("I6:O6"), False)
Worksheets("Sheet1").Cells(shrow + 6, shcol + 8) = m
Next i
End Sub