Split Excel spreadsheet by variable number of rows (eg: about 5,000 rows plus max 1,000)

How to split an excel file into several files not knowing in advance the exact number of rows where to tell Excel to split, but knowing only a rough number where to split ?

Example: 100,000 rows in total. In Column A, I have many rows which starts by the same cell content. I know that I have a maximum of 1,000 rows that have the same Column A content.

row# : Column A content :

row1:namedBB

row2:namedBB

...

row251:namedBB

row252:namedCC

...

row4,999:namedDD

row5,000:namedDD

...

row5,365:namedDD

row5,366:namedKEI

...etc...

In this example, I would like to split the file to about each 5,000 rows. But in fact the first split should be exactly on 5,366 (so the first xslx file will have content from row1 to row5,365, and the second xslx file will have from row5,366 to ?...).

Here is the VBA code that I use to split with a fixed number of rows.

Sub Splitter_fixed_number_of_rows()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim lTop As Long, lBottom, lCopy As Long
Dim LastRow As Long, LastCol As Long
Dim wbNew As Workbook, sPath As String

With ThisWorkbook.Sheets("recap")  ' sheetname to adapt
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
lTop = 2
Do

lBottom = lTop + 5000   ' fixed number of row where to split //to adapt
If lBottom > LastRow Then lBottom = LastRow
lCopy = lCopy + 1

Set wbNew = Workbooks.Add
.Range(.Cells(1, 1), .Cells(1, LastCol)).Copy
wbNew.Sheets(1).Range("A1").PasteSpecial
.Range(.Cells(lTop, 1), .Cells(lBottom, LastCol)).Copy
wbNew.Sheets(1).Range("A2").PasteSpecial

wbNew.SaveAs Filename:="TEST_" & Application.ActiveWorkbook.FullName & lCopy, FileFormat:=xlOpenXMLWorkbook ' split into .xslx files
wbNew.Close

lTop = lBottom + 1
Loop While lTop <= LastRow
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Thanks ;)