Menu
  1. Accueil
  2. Tech Forum
  3. Office Software
  4. Excel

Code to move a row based on fix values and paste it [Solved/Closed]

Report
Posts
2
Registration date
Wednesday February 5, 2014
Status
Member
Last seen
February 8, 2014
 -
Posts
2
Registration date
Wednesday February 5, 2014
Status
Member
Last seen
February 8, 2014
 -
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

1 reply

Answer 1 / 1
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
 795
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
Report
Posts
2
Registration date
Wednesday February 5, 2014
Status
Member
Last seen
February 8, 2014
thanks
Ask a question

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!