Transpose vertical data looping through entire column

I need help with this. I have data in ColA that is separated by a blank cell. The data is never the same number of rows so the only constant is the empty rows between the data. I need to transpose that data over and over again into ColB all the way till there is no more data. Here is a sample of my data:

ColA
data
data
data

data
data
data
data

data
data

etc.

I want the result to look similar to this:

ColB ColC ColD ColE
data data data
data data data data
data data
etc

Try:

Sub RunMe()
Dim LR As Long, StartRow As Long, EndRow As Long
Dim myRange As Range

LR = Range("A" & Rows.Count).End(xlUp).Row
StartRow = 1
Application.ScreenUpdating = False

Do
    If Range("A" & StartRow).Offset(1, 0).Value = "" Then
        Set myRange = Range("A" & StartRow)
        EndRow = Range("A" & StartRow).Row
    Else
        EndRow = Range("A" & StartRow).End(xlDown).Row
        Set myRange = Range("A" & StartRow, "A" & EndRow)
    End If

myRange.Copy

If Range("B1").Value = "" Then
    Range("B1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
Else
    Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End If
StartRow = EndRow + 2

Loop Until EndRow = LR

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Hi,

Try this... it may not be the most elegant solution but it seems to work :

Sub TransposeData()
   Dim i As Long, j As Long, ar, n As Long

   n = Range("A" & Rows.Count).End(xlUp).Row + 1
   ReDim ar(1 To n, 1 To 1)
   n = 0
   For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
      If Cells(i, 1) <> "" Then
         n = n + 1
         ar(n, 1) = Cells(i, 1)

         j = 2
         i = i + 1
         Do
            ReDim Preserve ar(1 To UBound(ar, 1), 1 To UBound(ar, 2) + 1)
            ar(n, j) = Cells(i, 1)
            i = i + 1
            j = j + 1
         Loop Until Cells(i, 1) = ""
      End If

   Next i
   Cells(1, 2).Resize(n, UBound(ar, 2)) = ar

End Sub