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

Mumps · Jul 24th 2021

You are very welcome.

Hyperventilate · Sep 20th 2021

Mumps, been using this macro splendidly. Just need another small addition please. Currently I need to execute the 'cut rows' macro manually for the number of times I want it to work. Could we do it in a way where I specify the number of times I want it to loop? Sometimes I want it to go 20 times and doing that manually is a pain. Attaching my file just for reference.

Mumps · Sep 20th 2021

I'm not sure what you mean. The 'CutRows' macro loops once through all the sheets referenced in column A of Sheet1. Are you saying that you want to loop through all those sheets more than once? Please explain in detail what you are trying to accomplish.

Hyperventilate · Sep 20th 2021

Quote from Mumps

I'm not sure what you mean. The 'CutRows' macro loops once through all the sheets referenced in column A of Sheet1. Are you saying that you want to loop through all those sheets more than once? Please explain in detail what you are trying to accomplish.

Yes, you are right. I want it to loop through all those sheets more than once. I'm creating sets of data in a particular sequence, one loop is one set and so on. Sometimes I need 20 sets, so I run the macro 20 times, was wondering if it can be done in the code itself (though the number of sets varies each time).

Mumps · Sep 21st 2021

Try:

Code

Sub CutRows()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, desWS As Worksheet, sh As Range, response As String, x As Long
    Set desWS = Sheets("Sheet2")
    response = InputBox("Enter the number of sets to create.")
    If response = "" Then Exit Sub
    For x = 1 To response
        For Each sh In Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
           Sheets(sh.Value).Rows("2:" & sh.Offset(, 1).Value + 1).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
           Sheets(sh.Value).Rows("2:" & sh.Offset(, 1).Value + 1).Delete
        Next sh
    Next x
    Application.ScreenUpdating = True
End Sub

Display More

Hyperventilate · Oct 25th 2021

Works perfect as always, thanks a ton!

Mumps · Oct 25th 2021

You are very welcome.

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

Participate now!

Share