Based on your description, I think this does what you need! Since there isn't a workbook example, I can only say it works on my test sheet and with your instructions.
Code:
Sub CopyPasteTranspose()
Dim i As Long
Dim LastRow As Long
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'Change Worksheet to suit
Application.ScreenUpdating = False
With ws
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Rows("1:1").Insert Shift:=xlDown
.Range("H1").Value = "Hdr"
.Range("H2:H" & .Range("A" & .Rows.Count).End(xlUp).Row).Formula = "=COUNTIF($A$2:A2,A2)"
For i = 2 To LastRow Step 8
.Range("A" & i).Resize(6).Copy
.Range("B" & i).PasteSpecial xlPasteAll, , , Transpose:=True
Next i
With .Range("H1", .Range("H" & .Rows.Count).End(xlUp))
.AutoFilter Field:=1, Criteria1:=">1", Criteria2:="0", Operator:=xlOr
.Offset(1).EntireRow.Delete
.AutoFilter
End With
.Rows("1:1").Delete Shift:=xlUp
.Columns("H:H").EntireColumn.Delete
End With
Application.Goto [A1]
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub