【VBA】交互按照要求拆分表

把数据粘贴到表名为“数据”的表里运行代码如下：

Sub 根据要求拆分表()

    Dim sht As Worksheet

    Dim k, i, j As Integer

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

    Dim l As Integer

l = InputBox("你要关键数据所在的列数是多少", "输入列数的提示框")

'删除无意义的表

Application.DisplayAlerts = False

If Sheets.Count > 1 Then

    For Each sht1 In Sheets

        If sht1.Name <> "数据" Then

            sht1.Delete

        End If

    Next

End If

Application.DisplayAlerts = True

irow = Sheet1.Range("A65536").End(xlUp).Row

'拆分表

For i = 2 To irow

    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

'拷贝数据

Dim rs As Integer

Dim cs As Integer

rs = Sheet1.Range("A1").End(xlDown).Row

cs = Sheet1.Range("A1").End(xlToRight).Column

'Cells(1, 1).Resize(rs, cs).Select

For j = 2 To Sheets.Count

    Sheet1.Cells(1, 1).Resize(rs, cs).AutoFilter Field:=l, Criteria1:=Sheets(j).Name

    Sheet1.Cells(1, 1).Resize(rs, cs).Copy Sheets(j).Range("a1")

Next

Sheet1.Cells(1, 1).Resize(rs, cs).AutoFilter

Sheet1.Select

MsgBox "已处理完毕"

End Sub