Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Excel macro to create new sheet every n-rows

I'm attempting to write a macro to take an excel file of several thousand rows and split the inital sheet's rows up into sheets of 250 rows per-sheet, not including the original header row, which should also be copied to each sheet. There are 13 columns total, and some of the fields are empty.

I can sort the document myself - that's not an issue - I just don't have the macro skill to figure this one out.

I've tried searching, and found a few examples, but none quite fit..such as this one.. create macro that will convert excel rows from single sheet to new sheets ..or this one.. Save data input from one sheet onto successive rows in another sheet

Any help?

like image 222
Noah Avatar asked Nov 18 '25 21:11

Noah


1 Answers

This should provide the solution you are looking for as well. You actually added your answer as I was typing it, but maybe someone will find it useful.

This method only requires that you enter the number of rows to copy to each page, and assumes you are on the "main" page once you execute it.

Sub AddSheets()
Application.EnableEvents = False

Dim wsMasterSheet As Excel.Worksheet
Dim wb As Excel.Workbook
Dim sheetCount As Integer
Dim rowCount As Integer
Dim rowsPerSheet As Integer

Set wsMasterSheet = ActiveSheet
Set wb = ActiveWorkbook

rowsPerSheet = 5
rowCount = Application.CountA(Sheets(1).Range("A:A"))
sheetCount = Round(rowCount / rowsPerSheet, 0)

Dim i As Integer

For i = 1 To sheetCount - 1 Step 1
With wb
    'Add new sheet
    .Sheets.Add after:=.Sheets(.Sheets.Count)

     wsMasterSheet.Range("A1:M1").EntireRow.Copy Destination:=Sheets(.Sheets.Count).Range("A1").End(xlUp)       

    wsMasterSheet.Range("A" & (rowsPerSheet + 2) & ":M" & (2 * rowsPerSheet + 1)).EntireRow.Cut Destination:=Sheets(.Sheets.Count).Range("A" & Rows.Count).End(xlUp).Offset(1)
    wsMasterSheet.Range("A" & (rowsPerSheet + 2) & ":M" & (2 * rowsPerSheet + 1)).EntireRow.Delete

    ActiveSheet.Name = "Rows " + CStr(((.Sheets.Count - 1) * rowsPerSheet + 1)) & " - " & CStr((.Sheets.Count * rowsPerSheet))
End With


Next

wsMasterSheet.Name = "Rows 1 - " & rowsPerSheet

Application.EnableEvents = True

End Sub
like image 166
joshua9k Avatar answered Nov 21 '25 16:11

joshua9k



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!