Transpose A Column Of Data In To A Table

[Excel Fox]

This will collate the data in a new sheet

Sub Consolidator()

    Dim rngInput As Range
    Dim lng As Long, lngCol As Long
    Set rngInput = Worksheets("Sheet1").Range("A2:A15000")
    Worksheets.Add After:=Sheets(Sheets.Count)
    For Each rngInput In rngInput
        If IsEmpty(rngInput) Then Exit For
        If rngInput.Font.Bold Then
            lng = lng + 1
            lngCol = 1
        Else
            lngCol = lngCol + 1
        End If
        Sheets(Sheets.Count).Cells(lng, lngCol).Value = rngInput.Value
    Next rngInput
    
End Sub