练习-拆分多表加载宏

较于之前做的修改

1. 表名不能限制为“数据”，需要抓取当前活动工作表的名字
2. 引用单元格不能用Sheet1，因为数据中有可能不在sheet1表，需要改成sheets(“表名")这种样式
3. 原来的代码只针对A-F列，未来待处理的数据可能很多列，需要开大一点，例如A-Z列

Sub chaifenshuju()

Dim sht As Worksheet
Dim k, i, j As Integer
Dim irow As Integer 
Dim str As String '修改1'

str = ActiveSheet.Name '修改2'

l = InputBox("请输入你要按哪列分")
If VBA.Information.IsNumeric(l) = False Or l < 1 Then
    Exit Sub
End If

'删除无意义的表
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
    For Each sht1 In Sheets
        If sht1.Name <> str Then '修改3'
            sht1.Delete
        End If
    Next
End If
Application.DisplayAlerts = True 




irow = Sheets(str).Range("a65536").End(xlUp).Row '修改4'
'拆分表
For i = 2 To irow
    k = 0
    For Each sht In Sheets
        If sht.Name = Sheets(str).Cells(i, l) Then 
            k = 1
        End If
    Next
    
    
    If k = 0 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets(str).Cells(i, l)   
    End If

Next

'拷贝数据'
For j = 2 To Sheets.Count
    Sheets(str).Range("a1:z" & irow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name  
    Sheets(str).Range("a1:z" & irow).Copy Sheets(j).Range("a1") 
Next

Sheets(str).Range("a1:z" & irow).AutoFilter  

Sheets(str).Select 

MsgBox "已处理完毕"

End Sub