Split data from columns to rows

Hi everybody.
Can someone help me extract the data as in the attachment.
Thank you.

Please see File

Sub test()
    Dim myAreas As Areas, LastR As Range, Heading As Range, i As Long, ii As Long
    With Range("b4").CurrentRegion.EntireColumn
        Set myAreas = .SpecialCells(2).Areas
        Set Heading = myAreas(1).Rows(1)
        Set LastR = [o4]
        For i = 1 To myAreas.Count
            For ii = IIf(i = 1, 2, 1) To myAreas(i).Rows.Count Step 2
                Union(Heading, myAreas(i).Rows(ii).Resize(2)).Copy
                LastR.PasteSpecial Transpose:=True
                Set LastR = Range("o" & Rows.Count).End(xlUp)(2)
            Next
        Next
    End With
End Sub

Thank you jindon.
I would like to ask more, if the data structure is like a new file and the desired result is as in the attached file, how should Code vba be fixed?

Sub test()
    Dim myAreas As Areas, LastR As Range, Heading As Range, r As Range
    Set Heading = [b4:k4]
    Set LastR = [p4]
    For Each r In Columns(1).SpecialCells(2, 1)
        If r.Address = r.MergeArea(1).Address Then
            Union(Heading, r(, 2).Resize(2, 10)).Copy
            LastR.PasteSpecial Transpose:=True
            LastR(, 0).Resize(10).Value = r.Value
        End If
        Set LastR = Range("p" & Rows.Count).End(xlUp)(2)
    Next
    [o4].CurrentRegion.Borders.Weight = 2
End Sub

Thanks jindon very much.
I would like to ask more, if the input and output data are like new files, how to edit vba Code?
Thank you.

Don't ever do like this again.

Mark the thread as "Solved" as your original question was solved already.

Thank you very much.