求助，怎么修改这段代码让原来按固定行拆分变成不固定行

下面这段代码是我现在在用的代码，效果是把一个表格按照每6000行拆成多个表格，我现在希望他能不按固定行分，比如第一次是6000行一个表，第二个表变成5998行，第三个表5996行这样，希望有大神能帮忙改下代码，谢谢
Sub mm()
Application.ScreenUpdating = False '关闭屏幕刷新
Dimwb As Workbook, stp
stp = 6000 '声明按6000的数据条数拆分。
Fori = 1 To cells(rows.count,1).End(3).Row Step stp '根据A列数据情况处理
k = k + 1 '记录已经复制了多少份
j = stp + i - 1 '记录每份文件的下界
Setwb = Workbooks.Add '新建工作簿
With wb
ThisWorkbook.Sheets(1).Range(i &":" & j).Copy .Sheets(1).Range("1:" & j - i +1) '复制内容
EndWith
wb.SaveAsThisWorkbook.Path & "/第" & k & "份名单.xls" '将新工作簿保存
wb.Close '关闭工作簿
Next
Application.ScreenUpdating= True '打开屏幕刷新
EndSub