Splitting Excel Spreadsheet into Multiple 500 cell spreadsheets

Hey

I am not sure if this is possible, but I was hoping someone could help me out.

I need to split a large amount of data into individual spreadsheets, which contain 500 rows per spreadsheet.

I have a spreadsheet which has data from cells A1:V89720.

A1:V1 is the header of each data field.

The header needs to be on all the individual spreadsheets.

They would just be saved to a desktop file called product split.

The name of each spreadsheet can just be a numerical count, for example, the first spreadsheet 1, the second 2, etc.

This should create 180 spreadsheets.

Is what I'm looking for possible, or will I have to manually create each sheet?

Thanks for taking the time to review this; it's much appreciated.

I apologise for not being clear in my initial request. I have a sheet with approximately 100,000 cells that I need to split into separate workbooks, each containing 500 cells.

This is because our system only allows uploads of 500 cells at a time.

I was hoping for some code that would divide the 100,000 cells in one workbook into 200 distinct workbooks. Then I can upload them directly to the system.

Thank you,

try this one.

Sub SplitWithHeader()
Dim WorkRng As Range
Dim xRow As Range
Dim SplitRow As Integer
Dim xWs As Worksheet
Dim i As Integer, j As Integer, k As Integer

On Error Resume Next
ExcelTitleId = "Split Row Numt"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", ExcelTitleId, WorkRng.Address, Type:=8)
SplitRow = Application.InputBox("Split Row Num", ExcelTitleId, 4, Type:=1)
Set xWs = WorkRng.Parent

Application.ScreenUpdating = False

' Get header row from the source sheet
Dim HeaderRow As Range
Set HeaderRow = WorkRng.Rows(1)

For i = 1 To WorkRng.Rows.Count Step SplitRow
' Determine the number of rows to copy
Dim numRows As Integer
numRows = SplitRow
If i + numRows - 1 > WorkRng.Rows.Count Then
numRows = WorkRng.Rows.Count - i + 1
End If

' Determine if the sheet being created is the first sheet or not
Dim isFirstSheet As Boolean
isFirstSheet = (i = 1)

' Create new sheet
Dim newSheet As Worksheet
Set newSheet = ThisWorkbook.Worksheets.Add(After:=xWs)

' Copy header row if not the first sheet
If Not isFirstSheet Then
HeaderRow.Copy
newSheet.Range("A1").PasteSpecial xlPasteAll
End If

' Copy rows to new sheet
WorkRng.Rows(i).Resize(numRows).Copy newSheet.Range("A" & IIf(isFirstSheet, 1, 2))
Next i

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub