vba macro to copy and transpose data in a column

ncheever

New Member
Joined
Apr 24, 2013
Messages
9
I am struggling to create/find vba code that can do the following: I have a worksheet with address information in column A like First Name, Last Name, phone number, email, title, physical address (each value occupying cells in column A, row by row).

There are a varying amount of blank spaces before I reach the next address data set and so on for about 3000 rows worth.

What makes this hard for me, is the varying number of blank cells that occur between the addresses, and also that not all addresses contain the same data points (i.e. some are missing phone or email).

I attempted to use the code for the first address "grouping":
HTML:
Range("A1").Select   
 Selection.End(xlDown).Select   
 Range(Selection, Selection.End(xlDown)).Select 
   Selection.Copy 
   Range("C2").Select    Selection.PasteSpecial 
Paste:=xlPasteAll, Operation:=xlNone, 
SkipBlanks:= False, _
Transpose:=True
This works fine once, but I need to declare variables so that I can do this over and over again.

Ultimately, the code needs to be able to copy the next address "grouping", transpose it horizontally into an adjacent column, and then go back to column A and find the next address "grouping", copy it, transpose it, and so on.

Any help/ or ideas would be very helpful!
(I am using Windows 8.1 and Excel 2013)

Thanks :cool:
NCheever
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,437
Try something like this...

Code:
[color=darkblue]Sub[/color] Transpose_Contacts()
    [color=darkblue]Dim[/color] rngArea [color=darkblue]As[/color] Range
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]For[/color] [color=darkblue]Each[/color] rngArea [color=darkblue]In[/color] Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
        rngArea.Copy
        Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues, Transpose:=[color=darkblue]True[/color]
    [color=darkblue]Next[/color] rngArea
    Application.CutCopyMode = [color=darkblue]False[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 

ncheever

New Member
Joined
Apr 24, 2013
Messages
9
AlphaFrog you're a genius! I was starting to doubt if it could be done, but it works perfectly. Very much appreciated!
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,479
Messages
5,770,323
Members
425,612
Latest member
martinijr

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top