Transposing hundreds of addresses in a column using VBA
Try this code
Sub CombineRows()
LastRow = Range("A" & Rows.Count).End(xlUp).Row
'set rowcount to row where you want 1st entry
RowCount = 1
NewRow = RowCount
Start = False
Do While RowCount <= LastRow
If Start = False Then
If Range("A" & RowCount) < "" Then
Start = True
StartRow = RowCount
End If
Else
If Range("A" & (RowCount + 1)) = "" Then
ColCount = 1
For MoveRow = StartRow To RowCount
Cells(NewRow, ColCount) = Cells(MoveRow, "A")
ColCount = ColCount + 1
Next MoveRow
NewRow = NewRow + 1
Start = False
End If
End If
RowCount = RowCount + 1
Loop
Rows(NewRow & ":" & LastRow).Delete
End Sub
"andreas" wrote:
Dear Experts:
I got hundreds of addresses in an excel sheet which need to be
transposed. The addresses are all in one column and arranged as
follows:
Name
Street
City
Tel
Blank row (1 to several)
Name Street
City
Tel
Blank row (1 to several)
etc. (another several hundred addresses more)
A macro should loop thru all these addresses and do the transposing
automatically. The addresses that are transposed should be placed
right next to each and every address.
Help is much appreciated. Thank you very much in advance. Regards,
Andreas
|