How do you do move every other cell?

[jagman68]

Hi guys, first time here, so be gentle with me!
I have a column of mixed data about 1200 rows in length., it alternates from date to hours. What I want to do is take every other cell and paste it in the next column to the right, next to the cell that was immediately above it.
I could write the macro from hell (select,cut,select,paste) but I'm sure there is a slicker way and it's beyond me! Anyone got any ideas how to do it?

many thanks in anticipation

Jagman68

 

[MickG]

Try:-

[COLOR=navy]Sub[/COLOR] MG19May41
[COLOR=navy]Dim[/COLOR] Lst [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
Lst = Range("A" & rows.Count).End(xlUp).row
[COLOR=navy]For[/COLOR] n = 2 To Lst [COLOR=navy]Step[/COLOR] 2
    [COLOR=navy]With[/COLOR] Range("A" & n)
        .Offset(-1, 1) = .value
    [COLOR=navy]End[/COLOR] With
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

This :- If you want to remove the Moved Value !!!

[COLOR="Navy"]Sub[/COLOR] MG19May47
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Range("A" & rows.Count).End(xlUp).row
[COLOR="Navy"]For[/COLOR] n = 2 To Lst [COLOR="Navy"]Step[/COLOR] 2
    [COLOR="Navy"]With[/COLOR] Range("A" & n)
        .Offset(-1, 1) = .value
        .value = ""
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[jagman68]

Hi MickG,
Thanks, that ran as sweet as singer sewing machine!
Much gratitude, I was dreding the prospect of that cut/paste macro!

Regards

Jagman68

 

[CharlesChuckieCharles]

another approach

Sub transposeRec()
Dim Inputrowct As Long
Dim Outputrowct As Long
Dim OutputColct As Long
Dim xldepth As Long
ActiveSheet.Range("A1").End
Selection.End(xlDown).Select
xldepth = ActiveCell.Row
Outputrowct = 1
OutputColct = 2
For x = 1 To xldepth
ActiveSheet.Cells(Outputrowct, OutputColct) = ActiveSheet.Cells(x, 1)
Debug.Print Cells(x, 1).Address
OutputColct = OutputColct + 1
If OutputColct = 3 Then ' hit record size one column over and one column more
OutputColct = 2
Outputrowct = Outputrowct + 1
End If

Next x
End Sub

 

[Weaver]

Here's another way:

Sub moveCells()
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row Step 2
        With Cells(i, "A")
            .Cut .Offset(-1, 1)
        End With
    Next
End Sub