vertical transposition macro

Try this:

Option Explicit

Sub TransposeWIP()
Dim Sizes As Range, Itms As Range
Dim SzRws As Long, Rw As Long

'Setup
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'clear output sheet if it exists
If Evaluate("ISREF(Results!A1)") Then Sheets("Results").Delete

'duplicate activesheet to create new output sheet
ActiveSheet.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Results"

'insert new columns and clear WIP totals
Range("AM:AN").Insert xlShiftToRight
On Error Resume Next
Range("AL:AL").SpecialCells(xlConstants, xlNumbers).ClearContents
On Error GoTo 0

'Sizes to copy/transpose
Set Sizes = Range("AP2:AY2")
SzRws = 10

'Rows to process
Set Itms = Range("F:F").SpecialCells(xlConstants, xlNumbers)

'Loop each row from the bottom up inserting values needed
For Rw = Itms.Rows.Count + 2 To 3 Step -1
    Range("A" & Rw).Offset(1).Resize(SzRws - 1).EntireRow.Insert xlShiftDown
    Range("AM" & Rw).Resize(SzRws).Value = _
        Application.WorksheetFunction.Transpose(Sizes)
    Range("AN" & Rw).Resize(SzRws).Value = _
        Application.WorksheetFunction.Transpose(Range("AP" & Rw, "AY" & Rw))
    Range("E" & Rw, "G" & Rw).Resize(SzRws).Value = _
        Range("E" & Rw, "G" & Rw).Value
    Range("AG" & Rw, "AK" & Rw).Resize(SzRws).Value = _
        Range("AG" & Rw, "AK" & Rw).Value
Next Rw

'Cleanup
Application.ScreenUpdating = True
End Sub