Excel macro to create new sheet every n-rows - excel

Question

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?

Answer 1

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

Answer 2

#pnuts's suggested solution by Jerry Beaucaire worked perfectly.
https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/parse-functions/rows
Option Explicit
Sub SplitDataNrows()
'Jerry Beaucaire, 2/28/2012
'Split a data sheet by a variable number or rows per sheet, optional titles
Dim N As Long, rw As Long, LR As Long, Titles As Boolean
If MsgBox("Split the activesheet into smaller sheets?", vbYesNo, _
"Confirm") = vbNo Then Exit Sub
N = Application.InputBox("How many rows per sheet?", "N-Rows", 50, Type:=1)
If N = 0 Then Exit Sub
If MsgBox("Include the title row1 on each new sheet?", vbYesNo, _
"Titles?") = vbYes Then Titles = True
Application.ScreenUpdating = False
With ActiveSheet
LR = .Range("A" & .Rows.Count).End(xlUp).Row
For rw = 1 + ---Titles To LR Step N
Sheets.Add
If Titles Then
.Rows(1).Copy Range("A1")
.Range("A" & rw).Resize(N).EntireRow.Copy Range("A2")
Else
.Range("A" & rw).Resize(N).EntireRow.Copy Range("A1")
End If
Columns.AutoFit
Next rw
.Activate
End With
Application.ScreenUpdating = True
End Sub
--
Option Explicit
Sub SplitWorkbooksByNrows()
'Jerry Beaucaire, 2/28/2012
'Split all data sheets in a folder by a variable number or rows per sheet, optional titles
'assumes only one worksheet of data per workbook
Dim N As Long, rw As Long, LR As Long, Cnt As Long, Cols As String, Titles As Boolean
Dim srcPATH As String, destPATH As String, fNAME As String, wbDATA As Workbook, titleRNG As Range
srcPATH = "C:\Path\To\Source\Files\" 'remember the final \ in this string
destPATH = "C:\Path\To\Save\NewFiles\" 'remember the final \ in this string
'determine how many rows per sheet to create
N = Application.InputBox("How many rows per sheet?", "N-Rows", 50, Type:=1)
If N = 0 Then Exit Sub 'exit if user clicks CANCEL
'Examples of usable ranges: A:A A:Z C:E F:F
Cols = Application.InputBox("Enter the Range of columns to copy", "Columns", "A:Z", Type:=2)
If Cols = "False" Then Exit Sub 'exit if user clicks CANCEL
'prompt to repeat row1 titles on each created sheet
If MsgBox("Include the title row1 on each new sheet?", vbYesNo, _
"Titles?") = vbYes Then Titles = True
Application.ScreenUpdating = False 'speed up macro execution
Application.DisplayAlerts = False 'turn off system alert messages, use default answers
fNAME = Dir(srcPATH & "*.xlsx") 'get first filename from srcPATH
Do While Len(fNAME) > 0 'exit loop when no more files found
Set wbDATA = Workbooks.Open(srcPATH & fNAME) 'open found file
With ActiveSheet
LR = Intersect(.Range(Cols), .UsedRange).Rows.Count 'how many rows of data?
If Titles Then Set titleRNG = Intersect(.Range(Cols), .Rows(1)) 'set title range, opt.
For rw = 1 + ---Titles To LR Step N 'loop in groups of N rows
Cnt = Cnt + 1 'increment the sheet creation counter
Sheets.Add 'create the new sheet
If Titles Then titleRNG.Copy Range("A1") 'optionally add the titles
'copy N rows of data to new sheet
Intersect(.Range("A" & rw).Resize(N).EntireRow, .Range(Cols)).Copy Range("A1").Offset(Titles)
ActiveSheet.Columns.AutoFit 'cleanup
ActiveSheet.Move 'move created sheet to new workbook
'save with incremented filename in the destPATH
ActiveWorkbook.SaveAs destPATH & "Datafile_" & Format(Cnt, "00000") & ".xlsx", xlNormal
ActiveWorkbook.Close False 'close the created workbook
Next rw 'repeat with next set of rows
End With
wbDATA.Close False 'close source data workbook
fNAME = Dir 'get next filename from the srcPATH
Loop 'repeat for each found file
Application.ScreenUpdating = True 'return to normal speed
MsgBox "A total of " & Cnt & " data files were created." 'report
End Sub