Transposing hundreds of addresses in a column using VBA
Hi andreas
Try something like this?
Sub transposeAddress()
Application.ScreenUpdating = False
Dim SpaceCount As Integer
Dim TransposeRow As Integer
Dim Transpose As Range
SpaceCount = 0
TransposeCount = 0
Set TransposeCell = Range("C1") 'Select your own cell
Range("A1").Select 'Select your own cell
While SpaceCount < 10 ' select your value
If ActiveCell.Value = "" Then
ActiveCell.Offset(1, 0).Select
SpaceCount = SpaceCount + 1
Else
TransposeCell.Offset(TransposeCount, 0) = ActiveCell.Offset(0, 0)
TransposeCell.Offset(TransposeCount, 1) = ActiveCell.Offset(1, 0)
TransposeCell.Offset(TransposeCount, 2) = ActiveCell.Offset(2, 0)
TransposeCell.Offset(TransposeCount, 3) = ActiveCell.Offset(3, 0)
TransposeCount = TransposeCount + 1
SpaceCount = 0
ActiveCell.Offset(4, 0).Select
End If
Wend
End Sub
|