Sub TransposeBom()
    Dim lr As Long, rng As Range, cel As Range
    Dim ChildNum As Integer
    Dim destSheet As Worksheet, writeRow As Long
    
With Sheets("Source or Input")
    lr = .Range("B" & Rows.Count).End(xlUp).Row
    Set rng = .Range("B2:B" & lr)
End With

Set destSheet = Sheets("Desired Output")
writeRow = 5   'to keep away from posted desired results

For Each cel In rng
    If cel.Value <> cel.Offset(-1).Value Then
        ChildNum = 1
    Else
        ChildNum = ChildNum + 1
    End If
    
    With destSheet
        If ChildNum = 1 Then
            writeRow = writeRow + 1
            .Cells(writeRow, 1).Resize(, 3).Value = cel.Resize(, 3).Value
            .Cells(writeRow, 4).Resize(, 5).Value = cel.Offset(, 3).Resize(, 5).Value
        Else
            .Cells(writeRow, 4).Offset(, (ChildNum - 1) * 5).Resize(, 5).Value = cel.Offset(, 3).Resize(, 5).Value
        End If
    End With
Next cel
End Sub