Option Explicit
Option Base 1

Sub Main()

Dim DataA
Dim DataB

Dim RowA As Long
Dim RowB As Long
Dim ColB As Long
Dim Wdth As Long
Dim RowX As Long

RowX = Cells(Rows.Count, 1).End(xlUp).Row
If RowX < 2 Then Exit Sub

DataA = Range("A1:A" & RowX)
RowB = 1: Wdth = 1
ReDim DataB(RowX, Wdth)

For RowA = 1 To RowX
       If DataA(RowA, 1) <> "" Then
           ColB = ColB + 1
           If ColB > Wdth Then
               Wdth = ColB
               ReDim Preserve DataB(RowX, Wdth)
           End If
           DataB(RowB, ColB) = DataA(RowA, 1)
       Else
           RowB = RowB + 1
           ColB = 0
       End If
Next RowA

Range("A1:A" & RowX).Value = ""
Cells(1, 1).Resize(RowB, Wdth).Value = DataB

End Sub