How can I programatically move cell contents

[Steve9491]

I need to move the contents of cells to a different cell with vba, see below.
Any help is appreciated.

I need to move r2c1 to r1c3, r4c1 to r3c3 and so on. Then delete rows r2,
r4, etc.

c1 c2 c3
r1 val1 val2
r2 val3
r3 val4 val5
r4 val6

End result
c1 c2 c3
r1 val1 val2 val3
r2 val4 val5 val6

 

[Lars-Åke Aspelin]

I need to move the contents of cells to a different cell with vba, see below.
Any help is appreciated.

I need to move r2c1 to r1c3, r4c1 to r3c3 and so on. Then delete rows r2,
r4, etc.

c1 c2 c3
r1 val1 val2
r2 val3
r3 val4 val5
r4 val6

End result
c1 c2 c3
r1 val1 val2 val3
r2 val4 val5 val6

Try this macro:

Sub move_cell_contents()
my_row = 2
Do While Cells(my_row, 1) <> ""
Cells(my_row - 1, 3) = Cells(my_row, 1)
Cells(my_row, 1).EntireRow.Delete shift:=xlUp
my_row = my_row + 1
Loop
End Sub

If you dont want delete the entire row 2 etc, then
replace EntireRow with Resize(1,2) in the macro.

Hope this helps / Lars-Åke

 

[Rick Rothstein]

Give this macro a try...

Sub ConsolidateData()
Dim R As Range
Dim SC As Range
Dim LastRow As Long
With Worksheets("Sheet5")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range("B1:B" & LastRow)
Set SC = .SpecialCells(xlCellTypeBlanks)
For Each R In SC
R.Offset(, -1).Copy R.Offset(-1, 1)
Next
SC.EntireRow.Delete
End With
End With
End Sub