Transpose N (variable) rows of data into multi columns

Hi csy101095 and welcome to the Forum. 

You can do that using the VBA code below- it's in the attached file (which you'll need to open with macros enabled - which is not the Microsoft default).

In the attached file you'll see some sample data in column A (but it could be hundreds of rows) and a green button labelled "Transpose to indexed rows" which is linked to the code.  Some cells have a (unique) integer number as the index and the code detects those (ignoring dates and decimals) and transposes subsequent rows until the next integer is encountered.

If you click the green button, it will run this code (commented so you can see what is happening):

Sub IndexToRow()

    Dim LstRw As Long, Rw As Long, IndRw As Long, TCol As Long

    ' determine last row in column A
    LstRw = Cells(Rows.Count, 1).End(xlUp).Row
    ' clear all columns except A
    ActiveSheet.UsedRange.Offset(0, 1).Clear

    ' loop from row 1 to last
    For Rw = 1 To LstRw
        'if a positive number and not a date...
        If IsNumeric(Cells(Rw, 1)) _
            And Cells(Rw, 1).Value > 0 _
            And Not IsDate(Cells(Rw, 1).Value) Then
            ' ... and it's an integer, set index as output row and reset output column
            If Int(Cells(Rw, 1).Value) = Cells(Rw, 1).Value Then
                IndRw = Cells(Rw, 1).Value
                TCol = 3
            End If
        End If
        ' write value output column on the indexed row
        Cells(IndRw, TCol) = Cells(Rw, 1).Value
        ' increment column index
        TCol = TCol + 1
    Next Rw
    ' tell user
    MsgBox "Transposed data by index number"

End Sub

The transposed data will be written to the right from columns C. I leave you to delete columns A  and B once you've checked it looks okay (but don't run the code again after that!).

Note that is there are gaps in your index sequence (e.g 1,2,3,5,7,8,9...) then you'll get empty rows (but that might be useful). You should repeat the index number or include integers in your data rows (but you could have decimals).

Hope this makes sense and fixes things for you. If so, please remember to mark this Answer as Selected (or do the same for another answer if you get one and prefer that).

Hello csy101095 and welcome to the forum. 

Here is the solution I came up with. In the attached file (Transpose to Columns - Ver1.xlsm) there are 2 macros. The "Transpose1" macro takes the data from column "A" and moves it (not copy) into rows beginning at "B1". The "ReSet1" macro recreates the original data list by copying the transposed data into column "A" and then deletes the transposed data.

June 22/24 - tweaked macros to handle blank (empty) cells

 "Transpose1"

Sub Transpose1()

Dim LRa As Long   ' last row of column "A"
LRa = Cells(Rows.Count, 1).End(xlUp).Row

Dim ChkRow As Long   ' row number of cell to be checked
Dim ChkCol As Long   ' column number of cell to be checked
Dim ListRow As Long   ' row number where values are copied
Dim ListCol As Long   ' column number where values are copied

ChkRow = 1
ChkCol = 1
ListRow = 0
ListCol = 2

Application.ScreenUpdating = False
Do Until ChkRow > LRa

If WorksheetFunction.IsNumber(Cells(ChkRow, ChkCol)) Then   ' cell value is a number
    ListRow = ListRow + 1
    ListCol = 2
        Cells(ChkRow, ChkCol).Cut _
            Destination:=Cells(ListRow, ListCol)

Else  ' cell value is not a number
    ListCol = ListCol + 1
        Cells(ChkRow, ChkCol).Cut _
            Destination:=Cells(ListRow, ListCol)

End If
ChkRow = ChkRow + 1

Loop
Application.ScreenUpdating = True
End Sub
'

"ReSet1"

Sub ReSet1()

Dim ChkRow As Long   ' row number of cell to be checked
Dim ChkCol As Long   ' column number of cell to be checked
Dim ListRow As Long   ' row number where values are copied
Dim ListCol As Long   ' column number where values are copied

ChkRow = 1
ChkCol = 2
ListRow = 1
ListCol = 1

Application.ScreenUpdating = False
Dim LRb As Long   ' last row of column "B"
LRb = Cells(Rows.Count, 2).End(xlUp).Row
Dim LCol As Long   ' last column in ChkRow

' recreate list in column "A"
Do Until ChkRow > LRb
    Cells(ListRow, ListCol) = Cells(ChkRow, ChkCol)
    ChkCol = ChkCol + 1
    ListRow = ListRow + 1
LCol = Cells(ChkRow, Columns.Count).End(xlToLeft).Column
If ChkCol > LCol Then
        ChkRow = ChkRow + 1
        ChkCol = 2
    End If
Loop

' clear cells with values entered by "Transpose1"
For ChkRow = 1 To LRb
    Range(Cells(ChkRow, 2), Cells(ChkRow, LCol)).ClearContents
Next

Application.ScreenUpdating = True
End Sub
'

If this is what you were looking to do, please mark my answer as selected.

Cheers   :-)