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

 

[Chris Bode via OfficeKB.com]

Please follow following steps
1.Right Click toolbar>click control box
2.From control box select a command button and draw it to your sheet
3.Double click the command button to open code window and paste following
codes
Private Sub CommandButton1_Click()
Dim row As Integer, col As Integer
row = 1
col = 1

Dim str1 As String

While Sheet1.Cells(row, col).Value <> ""
str1 = Sheet1.Cells(row + 1, col).Value

Sheet1.Cells(row, col + 2).Value = str1

Sheet1.Rows(row + 1).Delete

row = row + 1
Wend
End Sub

Now on clicking the command button, you get the result


Have a nice time….

Chris