VBA—按数据拆分成多张表格

VBA—按某个工作表某列数据拆分成多表格
Sub cfsj()

Dim i As Integer

Dim j As Integer

Dim hs, hss As Integer

Dim sht As Worksheet

Dim sht1 As Worksheet

Dim wk As Workbook

yjls = Excel.Application.InputBox(请输入拆分表格所依据的列, 请输入, 输入数字, , , , , 1)

Set sht1 = Excel.ActiveSheet

Set wk = Excel.ActiveWorkbook

hs = sht1.Range("a65536").End(xlUp).Row

For i = 2 To hs

    k = 0

  For Each sht In Sheets

      If sht.Name = sht1.Cells(i, yjls) Then

          k = k + 1

      End If

    Next

    If k = 0 Then

    Worksheets.Add after:=wk.Sheets(wk.Sheets.Count)

    wk.Sheets(wk.Sheets.Count).Name = sht1.Cells(i, yjls)

    End If

Next

  For j = 1 To wk.Sheets.Count

  hss = wk.Sheets(j).Range("a65536").End(xlUp).Row

  If hss = 1 Then

  sht1.Range("a1:z" & hs).AutoFilter Field:=yjls, Criteria1:=wk.Sheets(j).Name

  sht1.Range("a1:z" & hs).Copy wk.Sheets(j).Range("a" & hss)

  sht1.Range("a1:z" & hs).AutoFilter

  Else:

  sht1.Range("a1:z" & hs).AutoFilter Field:=yjls, Criteria1:=wk.Sheets(j).Name

  sht1.Range("a2:z" & hs).Copy wk.Sheets(j).Range("a" & hss + 1)

  sht1.Range("a1:z" & hs).AutoFilter

  End If

  Next

End Sub