vba macro to copy and transpose data in a column

[ncheever]

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":

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
NCheever

 

[AlphaFrog]

Try something like this...

[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]

AlphaFrog you're a genius! I was starting to doubt if it could be done, but it works perfectly. Very much appreciated!

 

[AlphaFrog]

You're welcome. Thanks for the feedback.