Sort column into rows of eight cells

Try this code:

Sub copy()
    Const PERIOD = 8, PASTE_FROM_ROW = 9
    Dim last_row As Long, i As Long
    
    last_row = Sheets(2).Cells(Rows.Count, "B").End(xlUp).Row
    For i = 0 To last_row \ PERIOD - 1
        Sheets(1).Cells(PASTE_FROM_ROW + i, "B").Resize(, PERIOD) = _
            WorksheetFunction.Transpose(Sheets(2).Cells(i * PERIOD + 1, "B").Resize(PERIOD))
    Next
End Sub

The code assumes that the range we want to copy and paste is always the same and always 8 rows.

I assume the original data looks like this:

Then we can copy and transpose the range to this:

by using this code:

Sub Copy_paste_transpose()

Dim lrow_copy As Long
Dim i As Long, j As Long
Dim rows_to_copy As Long

lrow_copy = Sheets(2).Cells(Rows.Count, "B").End(xlUp).Row 'Find last row in Sheet2

i = 9 'Start pasting at row 9
rows_to_copy = 7 'always "remove" one row.

For j = 1 To lrow_copy Step 8 'Loop through range and "jump" 8 rows at each looping.
    Sheets(2).Range(Sheets(2).Cells(j, "B"), Sheets(2).Cells(j + rows_to_copy, "B")).Copy 'Copy range
    Sheets(1).Range(Sheets(1).Cells(i, 2), Sheets(1).Cells(i, 2 + rows_to_copy)).PasteSpecial Paste:=xlPasteValues, Transpose:=True 'Paste range and transpose the copied range
    
    i = i + 1 'add one row after each paste

Next j

Application.CutCopyMode = False 'Deselect last copy selection

End Sub

Transpose a Column

Option Explicit

Sub TransposeColumn()
    Const ProcName As String = "TransposeColumn"
    On Error GoTo ClearError
    
    Const sID As Variant = 2 ' or "Sheet2"
    Const sFirst As String = "B1"
    
    Const dID As Variant = 1 ' or "Sheet1"
    Const dFirst As String = "B9"
    Const dcCount As Long = 8
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Create a reference to the Source First Cell Range.
    Dim sws As Worksheet: Set sws = wb.Worksheets(sID)
    Dim sfCell As Range: Set sfCell = sws.Range(sFirst)
    
    ' Using the 'GetTransposedColumn' function, write the transposed data
    ' to the Destination Array.
    Dim dData As Variant: dData = GetTransposedColumn(sfCell, dcCount)
    If IsEmpty(dData) Then Exit Sub
    
    ' Create a reference to the Destination First Cell Range.
    Dim dws As Worksheet: Set dws = wb.Worksheets(dID)
    Dim dfCell As Range: Set dfCell = dws.Range(dFirst)
    
    ' Check if the values from the Destination Array fit
    ' into the Destination Worksheet.
    Dim drCount As Long: drCount = UBound(dData, 1)
    If drCount > dws.Rows.Count - dfCell.Row + 1 Then Exit Sub
    If dcCount > dws.Columns.Count - dfCell.Column + 1 Then Exit Sub
    
    ' Create a reference to the Destination Range.
    Dim drg As Range: Set drg = dfCell.Resize(drCount, dcCount)
    
    ' Write the values from the Destination Array to the Destination Range.
    drg.Value = dData
    
    ' Clear the contents below the Destination Range.
    With drg
        Dim crCount As Long: crCount = .Worksheet.Rows.Count - .Row + 1
        If crCount > drCount Then
            .Resize(crCount - drCount).Offset(drCount).ClearContents
        End If
    End With
    
    MsgBox "Data transposed.", vbInformation, ProcName
    
ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
        & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
        & "        " & Err.Description
    Resume ProcExit
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the transposed values of a one-column range
'               in a 2D one-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetTransposedColumn( _
    ByVal FirstCell As Range, _
    Optional ByVal ColumnsCount As Long = 1) _
As Variant
    Const ProcName As String = "GetTransposedColumn"
    On Error GoTo ClearError
    
    If FirstCell Is Nothing Then Exit Function
    If ColumnsCount < 1 Then Exit Function
    
    Dim srg As Range
    Dim srCount As Long
    With FirstCell.Cells(1)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        srCount = lCell.Row - .Row + 1
        Set srg = .Resize(srCount)
    End With
    
    Dim sData As Variant
    If srCount = 1 Then
        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = srg.Value
    Else
        sData = srg.Value
    End If
    
    Dim dcrCount As Long: dcrCount = Int(srCount / ColumnsCount)
    Dim dcRem As Long: dcRem = srCount Mod ColumnsCount
    Dim drCount As Long
    If dcRem = 0 Then
        drCount = dcrCount
    Else
        drCount = dcrCount + 1
    End If
    
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To ColumnsCount)
        
    Dim r As Long
    Dim c As Long
    Dim n As Long
    
    If dcrCount > 0 Then
        For r = 1 To dcrCount
            For c = 1 To ColumnsCount
                n = n + 1
                dData(r, c) = sData(n, 1)
            Next c
        Next r
    Else
        r = 1
    End If
    
    If dcRem > 0 Then
        For c = 1 To dcRem
            n = n + 1
            dData(r, c) = sData(n, 1)
        Next c
    End If
    
    GetTransposedColumn = dData

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
        & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
        & "        " & Err.Description
    Resume ProcExit
End Function