Excel Macro to transpose addresses from rows to columns

[Dave]

I need to design a macro to transpose about 100+ addresses listed in column A
to 4 separate columns for name, street, and city/state/zip, & phone. The
macro needs to copy the 1st 4 lines of column 1 and then transpose to row 1
of 4 separate columns for a mail merge setup. Next, the macro needs to
increment down to row 5 of column 1 and transpose the next address to row 2
of the 4 mail merge columns.

The addresses are arranged like this in the first column:

The Little Laundrymat
1216 W. Dennis
Anytown, KS 12345
(888) 123-4567
Clean-It Cleaners & Coin Laundry
9514 Marshall Dr
Anytown, KS 12345
(888) 123-6754
De Soto Laundry
32505 Lexington Ave
Anytown, KS 12345
(888) 123-4765
Duds 'n Suds
6514 Martway St
Anytown, KS 12345
(888) 123-7654

The code looks like this below but I get a "1004 run-time error -
application defined or object defined error"

Sub Macro6()
'
' Macro6 Macro
' Macro recorded 5/23/2007
'
'
x = 1
Do While Cells(x, C1).Value <> ""
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=TRANSPOSE(RC[-2]:R[3]C[-2])"
ActiveCell.Range("A11").Select
Selection.FormulaArray = "=TRANSPOSE(RC[-2]:R[3]C[-2])"
ActiveCell.Offset(1, 0).Range("A1").Select
x = x + 4
Loop
End Sub

 

[Gord Dibben]

Dave

I posted this yesterday in response to your same question.

Sub ColtoRows()
Dim Rng As Range
Dim I As Long
Dim j As Long
Dim nocols As Long
Set Rng = Cells(Rows.Count, 1).End(xlUp)
j = 1
On Error Resume Next
nocols = InputBox("Enter Number of Columns Desired")

For I = 1 To Rng.Row Step nocols
Cells(j, "A").Resize(1, nocols).Value = _
Application.Transpose(Cells(I, "A").Resize(nocols, 1))
j = j + 1
Next
Range(Cells(j, "A"), Cells(Rng.Row, "A")).ClearContents

End Sub

You do not really need a macro to accomplish your task BTW.

In B1 enter this formula................

=INDEX($A:$A,(ROWS($1:1)-1)*4+COLUMNS($A:B)-1)

Copy across to Column E then select B1:E1 and copy down untill you get zeros.


Gord Dibben MS Excel MVP

 

[Dave]

Gord

For whatever reason, I never could find my Saturday posting in any groups
under Excel?! I'm glad you persisted though because both of your suggestions
worked. Thanks Much!! I can get some direct mail marketing done now!

Best Regards, Dave
--
DSM

Dave

I posted this yesterday in response to your same question.

Sub ColtoRows()
Dim Rng As Range
Dim I As Long
Dim j As Long
Dim nocols As Long
Set Rng = Cells(Rows.Count, 1).End(xlUp)
j = 1
On Error Resume Next
nocols = InputBox("Enter Number of Columns Desired")

For I = 1 To Rng.Row Step nocols
Cells(j, "A").Resize(1, nocols).Value = _
Application.Transpose(Cells(I, "A").Resize(nocols, 1))
j = j + 1
Next
Range(Cells(j, "A"), Cells(Rng.Row, "A")).ClearContents

End Sub

You do not really need a macro to accomplish your task BTW.

In B1 enter this formula................

=INDEX($A:$A,(ROWS($1:1)-1)*4+COLUMNS($A:B)-1)

Copy across to Column E then select B1:E1 and copy down untill you get zeros.


Gord Dibben MS Excel MVP

I need to design a macro to transpose about 100+ addresses listed in column A
to 4 separate columns for name, street, and city/state/zip, & phone. The
macro needs to copy the 1st 4 lines of column 1 and then transpose to row 1
of 4 separate columns for a mail merge setup. Next, the macro needs to
increment down to row 5 of column 1 and transpose the next address to row 2
of the 4 mail merge columns.

The addresses are arranged like this in the first column:

The Little Laundrymat
1216 W. Dennis
Anytown, KS 12345
(888) 123-4567
Clean-It Cleaners & Coin Laundry
9514 Marshall Dr
Anytown, KS 12345
(888) 123-6754
De Soto Laundry
32505 Lexington Ave
Anytown, KS 12345
(888) 123-4765
Duds 'n Suds
6514 Martway St
Anytown, KS 12345
(888) 123-7654

The code looks like this below but I get a "1004 run-time error -
application defined or object defined error"

Sub Macro6()
'
' Macro6 Macro
' Macro recorded 5/23/2007
'
'
x = 1
Do While Cells(x, C1).Value <> ""
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=TRANSPOSE(RC[-2]:R[3]C[-2])"
ActiveCell.Range("A11").Select
Selection.FormulaArray = "=TRANSPOSE(RC[-2]:R[3]C[-2])"
ActiveCell.Offset(1, 0).Range("A1").Select
x = x + 4
Loop
End Sub

 

[Gord Dibben]

Got through this time and that's what counts.

Thanks for the feedback.

Gord