Previous Topic Next Topic

Code to move a row based on fix values and paste it

Solved/Closed
sonkar Posts 2 Registration date Wednesday February 5, 2014 Status Member Last seen February 8, 2014 - Feb 5, 2014 at 11:18 PM
sonkar Posts 2 Registration date Wednesday February 5, 2014 Status Member Last seen February 8, 2014 - Feb 8, 2014 at 11:18 PM
Hello Gurus,
This is my 1st question and I m a beginner in macros .I wanted a code to move a row based on a fix values and paste it in the same sheet. ITs like I have downloaded data sheet and the file which I got has split the rows and pasted the remaining data in a row below it.so I would like to add these two rows as one.
as shown below .
User ID Password Role Description
plant material
11111 222222 aa xxxx
zzzz 7889


After Macro

User ID Password Role Description plant material
11111 222222 aa xxxx zzzz 7889

Thanks
Related:

1 reply

Answer 1 / 1
venkat1926 Posts 1864 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 810
Feb 6, 2014 at 11:34 PM
suppose data is like this

User ID Password Role Description
plant material
11111 222222 aa xxxx
zzzz 7889
11111 222222 aa xxxx
zzzz 7889
11111 222222 aa xxxx
zzzz 7889
11111 222222 aa xxxx
zzzz 7889


ths is in sheet1. copy this in sheet2 from A1 to preserve the data configuration

now try this macro 

Sub test()
Dim j As Integer, k As Integer
Worksheets("sheet1").Activate
Range(Range("A2"), Range("A2").End(xlToRight)).Cut
Range("a1").End(xlToRight).Offset(0, 1).Select
ActiveSheet.Paste
Range("a2").EntireRow.Delete
j = Range("A1").End(xlDown).Row
For k = j To 2 Step -1
If k Mod 2 <> 0 Then
Range(Cells(k, 1), Cells(k, 1).End(xlToRight)).Copy Cells(k - 1, 1).End(xlToRight).Offset(0, 1)
Cells(k, 1).EntireRow.Delete
End If
Next k
End Sub

Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Cells(1, 1)
End Sub
0
sonkar Posts 2 Registration date Wednesday February 5, 2014 Status Member Last seen February 8, 2014
Feb 8, 2014 at 11:18 PM
thanks
0