4 单元格2

Sub chaifenshuju()

Dim sht As Worksheet

Dim k, i, j, m As Integer

Dim irow As Integer '这个说的是一共多少行

Dim l As Integer

l = InputBox("请输入你要按哪列分 请输入阿拉伯数字")

'删除无意义的表

Application.DisplayAlerts = False

If Sheets.Count > 1 Then

   For Each sht In Sheets

       If sht.Name <> "数据" Then

           sht.Delete

       End If

   Next

End If

Application.DisplayAlerts = True '这个地方上课的时候我没改成true，请大家注意一下

irow = Sheet1.Range("a65536").End(xlUp).Row(不用说dim  irow as )

'拆分表

For i = 2 To irow

    k = 0(注意K=0的位置，容易放错)

   For Each sht In Sheets

       If sht.Name = Sheet1.Cells(i, l) Then

           k = 1

       End If

   Next

   If k = 0 Then

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

       Sheets(Sheets.Count).Name = Sheet1.Cells(i, l)

   End If

Next

'拷贝数据

For j = 2 To Sheets.Count

   Sheet1.Range("a1:f" & irow).AutoFilter Field:=l,Criteria1:=Sheets(j).Name（没有引号）

   Sheet1.Range("a1:f" & irow).CopySheets(j).Range("a1")

Next

Sheet1.Range("a1:f" &

irow).AutoFilter

Sheet1.Select

MsgBox "已处理完毕,请男神查看e盘数据文件夹"

'保存到文件

Application.ScreenUpdating = False

For Each sht In Sheets

sht.Copy

ActiveWorkbook.SaveAs Filename:="e:\数据\" & sht.Name & ".xlsx"

ActiveWorkbook.Close

Next

Application.ScreenUpdating = ture

End Sub

在拆分表里面有个魔性操作，没有定义sht作为worksheet，直接写的sheet竟然操作会出现问题。

还有注意sheets(i)是不需要加引号的，标点符号容易出错，自己需要好好处理。