该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
用range复制方法的话又没有用筛选的话以下两种
注意拆分1是多重选定区域，所以复制的是值而不会复制公式，拆分2是多次复制单一区域，所以会复制公式，如果你的数据没有公式那么两个是没有区别的。至于效率没有测试，估计慢得差不多。
Sub 拆分1()
Dim rng As Range, s As String, ng As Range, r As Range, i As Long
With Worksheets("总表")
Set rng = .Range("A1").CurrentRegion
For Each ng In .Range("M2:M4")
s = ng.Value
Worksheets.Add(, Sheets(Sheets.Count)).Name = s
Set r = rng.Rows(1)
For i = 2 To rng.Rows.Count
If rng.Cells(i, 1) = s Then Set r = Union(r, rng.Rows(i))
Next i
r.Copy Worksheets(s).Cells(1)
Next ng
End With
End Sub
Sub 拆分2()
Dim rng As Range, s As String, ng As Range, i As Long, j As Long
Set rng = Worksheets("总表").Range("A1").CurrentRegion
For Each ng In Worksheets("总表").Range("M2:M4")
s = ng.Value
With Worksheets.Add(, Sheets(Sheets.Count))
.Name = s
j = 2
rng.Rows(1).Copy .Cells(1)
For i = 2 To rng.Rows.Count
If rng.Cells(i, 1) = s Then rng.Rows(i).Copy .Cells(j, 1): j = j + 1
Next i
End With
Next ng
End Sub