# Help! Excel Macro: How to move every 2nd row to next column?



## misuszatek (Aug 4, 2009)

I barely use Excel but I have a list to modify / reformat.

What I have is about 25,000 names and addresses in one column:

*address 1
_________
name1
_________
**address 2
_________
name2
_________
**address 3
_________
name 3*

what I want to achieve is 2 columns where one is address , other is names

*__________________
address 1 | name1
__________________
address 2 | name 2
__________________
address 3 | name 3
__________________*

etc .

Can you help me out with macro to move every 2nd cell / row in first column and move them to next column , like it's shown in example above?

thank you for any help


----------



## Jimmy the Hand (Jul 28, 2006)

Hi
Try this code:


```
Sub Test()
    Dim EvenCell As Range
    
    [COLOR="Red"]Set EvenCell = Range("A2")[/COLOR]
    Do While EvenCell <> ""
        With EvenCell
            .Copy .Offset(-1, 1)
            .ClearContents
        End With
        Set EvenCell = EvenCell.Offset(2)
    Loop
    Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
```
It is assumed that the first Name field (name1) is in cell A2. If not, change the red code line accordingly. 
Note: the macro uses the active worksheet, so make sure you activate the sheet with the data before running it.

Jimmy


----------



## misuszatek (Aug 4, 2009)

thank you, it works..almost 

...the only thing is ..once cells are moved ...whole sheet is cleared. Should I change some settings or define the range or something?


----------



## bomb #21 (Jul 1, 2005)

No need for a macro.

Assuming address1 is in A1, use:

*=INDIRECT("A"&(ROW()*2-1))*

in (e.g.) C1, and:

*=INDIRECT("A"&ROW()*2)*

in D1. Copy these down as far as you need.

Then with cols C & D selected, use Copy > Edit > Paste Special > Values to "hard-code" the formula results.


----------



## Jimmy the Hand (Jul 28, 2006)

Well, maybe column A was empty. In that case the code really deletes everything.
I think with this little tweak it should work (of course, change the A2 to what is required).

```
Sub Test()
    Dim EvenCell As Range
    
    Set EvenCell = Range("A2")
    Do While EvenCell <> ""
        With EvenCell
            .Copy .Offset(-1, 1)
            .ClearContents
        End With
        Set EvenCell = EvenCell.Offset(2)
    Loop
    EvenCell.EntireColumn.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
```


----------

