【改进版】
Option Explicit
Option Base 1
Sub 按指定列分组拆分数据()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim self As Worksheet
Set self = ActiveSheet
Dim nLastRowNum As Long
Dim nLastColumnNum As Long
Dim i As Long
' 删除其他的sheet
For i = Sheets.Count To 1 Step -1
If Sheets(i).Name <> self.Name Then
Sheets(i).Delete
End If
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'获取全部数据范围
nLastRowNum = Cells<