I found this on the DG a while back:
Sub rearrange()

Dim curselection As Range
Dim i As Integer

Set curselection = Range("A1") 'or wherever you start

Do While curselection < ""

If Not curselection.Offset(1, 0) = "" Then
i = 1
Do
curselection.Offset(1, 0).Copy Destination:=curselection.Offset(0, i)
curselection.Offset(1, 0).EntireRow.Delete
i = i + 1
Loop Until curselection.Offset(1, 0) = ""
End If

curselection.Offset(1, 0).EntireRow.Delete
Set curselection = curselection.Offset(1, 0)

Loop

End Sub

HTH,
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"JIm Samson" wrote:

I'm trying to create records from column data with a macro that will build a
range in a column, from a starting cell, that will add the next cell down
until it finds an empty cell. Then it will do a transpose on that range.
From the last cell in the range, it will repeat the sequence until it
reaches 2 empty cells or the end of the column or worksheet.

Because the lengths of the column cells vary, I can't just use an offset.

Any ideas are welcome,

Jim