我的资产表有1行相同的，2行相同的........6行相同的。现在需要不同名的单独保存成大都文件。现在找了个宏命令是单独行循环取的，请问2行 3行的要怎么改啊
Sub 每行拆分成工作簿()
Dim wb, i, j
Application.ScreenUpdating = False
For j = 2 To [a65536].End(xlUp).Row '从第2行开始循环取行
Union(Rows(1), Rows(j)).Copy '将表头和相应行一起复制
Set wb = Workbooks.Add '新建一个工作簿
wb.Sheets(1).Paste '将复制的内容粘贴
On Error Resume Next
Kill ThisWorkbook.Path & "\" & wb.Sheets(1).Range("A2") & ".xlsx" '先把同路径下同名的文件删除，防止报错
wb.SaveAs ThisWorkbook.Path & "\" & wb.Sheets(1).Range("A2") & ".xlsx" '保存工作簿，以新工作簿的A2单元格为名
wb.Close '关闭工作簿
Set wb = Nothing '释放wb
Next
Application.ScreenUpdating = True
End Sub
For j = 2 To [a65536].End(xlUp).Row '从第2行开始循环取行
怎么改成每2行复制一次
每3行复制一次啊

就是一行跳一行？
for j = 2 to XXX step 2

判断这一行是否与上一行相同，如果相同则共同放进复制组。

意思不明

Sub 每行拆分成工作簿_1()
Dim wb, I%, J%
Dim RowArr() As Integer, IsSave As Boolean
Application.ScreenUpdating = False
J = 2
Do While Len(Range("A" & J)) > 0 '从第2行开始循环取行
I = 0
Do While Range("A" & J) = Range("A" & J + 1)
I = I + 1
Loop
Range("1:1," & J & ":" & J + I).Copy '将表头和相应行一起复制
' Union(Rows(1), Rows(J)).Copy '将表头和相应行一起复制
Set wb = Workbooks.Add '新建一个工作簿
wb.Sheets(1).Paste '将复制的内容粘贴
On Error Resume Next
Kill ThisWorkbook.Path & "\" & wb.Sheets(1).Range("A2") & ".xlsx" '先把同路径下同名的文件删除，防止报错
wb.SaveAs ThisWorkbook.Path & "\" & wb.Sheets(1).Range("A2") & ".xlsx" '保存工作簿，以新工作簿的A2单元格为名
wb.Close '关闭工作簿
Set wb = Nothing '释放wb
J = J + 1 + I
Loop
Application.ScreenUpdating = True
End Sub