Transpose Macro

[chrisscotty]

Hello All...

I have yet another macro I would like to get data in to a contact manager..if any of you know of a tool that helps you transpose I would also be curious to try it out as I often have data I need to transpose so I can export data via tab delimited file in to a contact manager.


1. Ms. Mandy Tezizina, RPA Transportation Specialist
Mulixe
430 - 55 Metcalfe Street, Ottawa, ON K1P 6L5
Phone: 1-913-230-2251 x 228 Fax: 1-913-563-0878 Email: mandy_teziz@mulixe.ca
Website: www.mulixe.ca 

basically the data looks like this...and I want it all to be like this



mandy tezizine |transportation specialist| etc

I want to attach an excel file of what it looks like in excel but I dont see that option..hmm

 

[Von Pookie]

You can't attach files here. You can, however, use the HTML Maker add-in and provide a sort of screen shot. The link to download it is at the bottom of this page.

 

[chrisscotty]

for transpose.xls
	A	B	C	D
1	1. Ms. Mandy Tezizina, RPA	Transportation Specialist
2		Mulixe
3		430 - 55 Metcalfe Street, Ottawa, ON K1P 6L5
4		Phone: 1-913-230-2251 x 228 Fax: 1-913-563-0878 Email: mandy_teziz@mulixe.ca
5		Website: www.mulixe.ca
6	2. Mr. Pet Buzzinet, CRCE	Vocational Rehabilitation Worker
7		Darlington Community Health Form
8		900 Merrivale Road, Kawa, OHIO 24698
9		Phone: 1-413-722-9731 x 316 Fax: 1-413-722-8244 Email: pbuzzzinet@darlington.us
10
11	I want the data to look like below
12
13	mandy texzzina	Transportation Specialist	430-55 metcalfe
Sheet1

 

[Smitty]

You need to strip out the

 &

tags for the HTML to work.

Also something to keep in mind: you may not want to post personal information on a public board. Just make some up.

This might work for you:

Sub Transpose()
    Application.Goto Reference:=[A1]
    Do While ActiveCell <> ""
        If ActiveCell.Offset(1, 0) = "" Then ActiveCell.Offset(1, 1).Cut ActiveCell.Offset(0, 2)
        If ActiveCell.Offset(2, 0) = "" Then ActiveCell.Offset(2, 1).Cut ActiveCell.Offset(0, 3)
        If ActiveCell.Offset(3, 0) = "" Then ActiveCell.Offset(3, 1).Cut ActiveCell.Offset(0, 4)
        If ActiveCell.Offset(4, 0) = "" Then ActiveCell.Offset(4, 1).Cut ActiveCell.Offset(0, 5)
        If ActiveCell.Offset(5, 0) = "" Then ActiveCell.Offset(5, 1).Cut ActiveCell.Offset(0, 6)
        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown).Offset(-1, 0)).EntireRow.Delete
        ActiveCell.End(xlDown).Select
    Loop
End Sub

Hope that helps,

Smitty