运行错误下标越界,专业版提示下标越界

该楼层疑似违规已被系统折叠 隐藏此楼查看此楼

用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