Copy and paste every 10 Excel rows into another workbook loop

Question

From an Excel workbook (original_workbook.xlsx) of 100 rows (or any number of rows, preferably).

I would like a Macro that copies and pastes every 10 rows into a new Excel workbook that is named Workbook_[date]_[random number].xlsx.

Note: that the first row of original_workbook.xlsx is the header for each new Workbook. Using a recorded Macro, I have the following VB code thus far:

Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
    "C:\path\Workbook_[date]_[random number].xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False

Windows("original_workbook.xlsx").Activate
Rows("1:1").Select
Selection.Copy
Windows("Workbook_[date]_[random number].xlsx").Activate
ActiveSheet.Paste
Windows("original_workbook.xlsx").Activate
Rows("2:11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Workbook_[date]_[random number].xlsx").Activate
Range("A2").Select
ActiveSheet.Paste
Range("A2").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
Windows("original_workbook.xlsx").Activate
Windows("Workbook_[date]_[random number].xlsx").Activate

I would like the above code to loop until there are no more rows left.

I suspect Rows("2:11").Select will need to change. I've looked up doing For i, but it wasn't working. Thank you.

Answer 1

Recording a macro is a great way to get some idea of the framework and individual commands involved in a proves but the resulting code can be verbose in some areas and lacking in others.

Your recorded macro was specifically lacking the names of the worksheets that were being copied and pasted to and from. This was not part of the recording as they were already the active worksheets . For the purposes of the code below, I've simply used Sheet1 on both workbooks.

Dim rw As Long, nwb As Workbook, owb As Workbook

Set owb = Windows("original_workbook.xlsx")
Set nwb = Workbooks.Add
nwb.SaveAs Filename:= _
    "C:\path\Workbook_[date]_[random number].xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False

With owb.Sheets("Sheet1")
    .Rows("1:1").Copy _
        Destination:=nwb.Sheets("Sheet1").Range("A1")
    For rw = 2 To 92 Step 10
        .Cells(rw, 1).Resize(10, 1).EntireRow.Copy _
            Destination:=nwb.Sheets("Sheet1").Range("A2").Offset(rw, 0)
    Next rw
    nwb.Save
    .Activate
End With

nwb.Activate

I've set up a loop but it really isn't clear where you want the results. If they were stacked one on top of the other then it would be infinitely easier to just copy and paste them all at once.

See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.