下面这段代码是我现在在用的代码，效果是把一个表格按照每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

自顶下

Sub mm()
Application.ScreenUpdating = False '关闭屏幕刷新
Dimwb As Workbook, arr(0 to 2),n%,j%,k% ,i%
arr=array(6000,4000,3596)'放置你要每次拆分的行数
i=cells(rows.count,1).End(3).Row
do
j = j+arr(n)
Set wb = Workbooks.Add '新建工作簿
With wb
ThisWorkbook.Sheets(1).Range(1+k &":" & j).Copy .Sheets(1).Range("a1") '复制内容
EndWith
wb.SaveAsThisWorkbook.Path & "/第" & k & "份名单.xls" '将新工作簿保存
wb.Close '关闭工作簿
n=n+1
k=k+j
loop until j=i
Application.ScreenUpdating= True '打开屏幕刷新
EndSub
没测试