数据如下：

要求：当输入列序号是，按当前列的值，拆分表格，利用C列，序列号为3，输入3时，安装华东，华北，华南等拆分表格汇总数据，并按期名称命名尽量新表。

效果如下：

输入序号3

输出：

输入列序号4

输出

实现代码：

Sub delect_table()
Dim sht As Worksheet
Application.DisplayAlerts = False '警示框，关闭，否则每次关闭表格是需手动确认。需成对出现，后面需true

Sheets("数据").Select
For Each sht In Worksheets
    If sht.Name <> "数据" Then
        sht.Delete
    End If
Next

Application.DisplayAlerts = True

End Sub



Sub split_table()

Call delect_table  '程序调用，也可把程序代码复制在此处

Dim sht As Worksheet
Dim k, i, j, l As Integer
Dim nrow As Integer '代表数据有多少行，方便程序引用

l = InputBox("请输入要按列拆分表的序列号：")

'col = InputBox("请输入要按列拆分表的序列字母：")
'l = Range(col & 1).Column

’防错提示，输入错误退出程序
If VBA.IsNumeric(l) = False Or l < 1 Then
    MsgBox ("请输入正确格式")
    Exit Sub
End If

Sheets("数据").Select
nrow = Sheets("数据").Range("a" & Rows.Count).End(xlUp).Row 'Rows.Count在Excel中通常返回1048576（对于Excel 2007及以后的版本）

'拆分表
For i = 2 To nrow
    k = 0 '预设一个条件，当为0时，创建工作簿中没有重复名称的表，即新表
    For Each sht In Sheets
        If sht.Name = Sheets("数据").Cells(i, l) Then
            k = 1 '如果检测有重复的表名，不创建表
        End If
    Next
    
    If k = 0 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets("数据").Cells(i, l) 'l列，i行
    End If
    
Next

'拷贝数据
For j = 2 To Sheets.Count
    Sheets("数据").Range("a1:j" & nrow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name 'Criteria1,书写肯是数字1，不是字母
    Sheets("数据").Range("a1:j" & nrow).Copy Sheets(j).Range("a1")
Next

Sheets("数据").Range("a1:j" & nrow).AutoFilter
Sheets("数据").Select

End Sub

'备注--其他获取行号的方法：
'Sheets(2).Range("a2") = Sheets(1).Range("a65553").End(xlUp).Row
'Sheets(2).Range("a3") = Sheets("数据").Range("a" & Cells(Rows.Count, 1).End(xlUp).Row).Row '返回的是一个单元格，.row则返回单元格的行号
'Sheets("数据").Range("a1", Cells(Rows.Count, 1).End(xlUp)).Select '返回的是一个区域,不是一个数字

备注：

• 拆分按钮，可通过插入---形状---矩形设置。

• 可通过设置其属性，固定其位置及大小，不随表格行列变动而变动：

• 关联宏程序，点击按钮右键设置：