transposing multiple rows into one column




I have this code which I am using to transpose data to one column....

Sub Transpose()
Dim i As Long, k As Long, j As Integer
Application. ScreenUpdating = False
i = 0
k = 1
While Not IsEmpty( Cells(k, 2))
j = 2
While Not IsEmpty(Cells(k, j))
i = i + 1
Cells(i, 1) = Cells(k, j)
Cells(k, j).Clear
j = j + 1
k = k + 1
Application.ScreenUpdating = True
End Sub

but this only works if all cells contain data. I have grid of data
where there are some empty cells - no data in them.
Need help to modify this code to accept the "null" (no data in cells).

Thanks heaps for your assistance.


If your last cell in the first column of data is blank and the last row of
the 2nd column is not blank then then this will leave off the last row of the
2nd column. If that is a problem then feel free to get back to me.

Sub Transpose()

Dim i As Long
Dim k As Long
Dim rngColumn As Range
Dim cel As Range


i = 0
k = 1 'Set k to equal first row of data

With Sheets("Sheet1")
Set rngColumn = .Range(.Cells(k, 2), _
.Cells(.Rows.Count, 2).End(xlUp))
End With

With rngColumn
For Each cel In rngColumn
cel.Offset(i, -1) = cel
i = i + 1
cel.Offset(i, -1) = cel.Offset(0, 1)
Next cel
End With

End Sub

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question