Cut-Paste specified number of rows from different sheets into one sheet

  • I have a requirement where I am given ten sheets of data and a specified number of rows from each sheet need to be moved into Sheet2. I've mentioned this order in Sheet1 (sample attached).


    1. I need them to be cut-pasted because this process may repeat after one step of cut paste so I don't want duplication of data

    2. The macro should run only once (cut-paste once) because I should be able to change the values in Sheet1 if required before I run the macro again.

    2. Data needs to be pasted in the same order as specified in Sheet1

    3. All data columns need to be copied from the sheets (columns may vary across sheets, hence all available columns need to be cut-pasted)


    Any help would be very appreciated because I don't want to do this manually :)

    Files

    • Sample.xlsx

      (69.45 kB, downloaded 35 times, last: )
  • If you want to run the macro again after the first time, do you want the new data to be appended below the existing data in Sheet2 or do you want to delete the old data before pasting the new data?

    You can say "THANK YOU" for help received by clicking the :thumbup: icon in the bottom right corner of the helper's post.
    Practice makes perfect. I am very far from perfect so I'm still practising.

  • If you want to run the macro again after the first time, do you want the new data to be appended below the existing data in Sheet2 or do you want to delete the old data before pasting the new data?

    I need the data to be appended below, so at the ultimate end of the exercise, there will be zero data in all sheets except Sheet2 where all this data will exist.

  • Try:

    Code
    1. Sub CutRows()
    2. Application.ScreenUpdating = False
    3. Dim ws As Worksheet, desWS As Worksheet, sh As Range
    4. Set desWS = Sheets("Sheet2")
    5. For Each sh In Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
    6. Sheets(sh.Value).Rows("2:" & sh.Offset(, 1).Value + 1).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
    7. Sheets(sh.Value).Rows("2:" & sh.Offset(, 1).Value + 1).Delete
    8. Next sh
    9. Application.ScreenUpdating = True
    10. End Sub

    You can say "THANK YOU" for help received by clicking the :thumbup: icon in the bottom right corner of the helper's post.
    Practice makes perfect. I am very far from perfect so I'm still practising.

  • Works absolutely perfect! Thank you so much.

    One small thing: can we modify the code in a way that the sheet names don't matter? Because my sheet names aren't always Sheet2, Sheet3, etc. but the order of the sheets remain the same.

  • Try:

    You can say "THANK YOU" for help received by clicking the :thumbup: icon in the bottom right corner of the helper's post.
    Practice makes perfect. I am very far from perfect so I'm still practising.

  • Please ignore the previous post and try this version:

    You can say "THANK YOU" for help received by clicking the :thumbup: icon in the bottom right corner of the helper's post.
    Practice makes perfect. I am very far from perfect so I'm still practising.