1、 把数据粘贴到新建工作簿的sheet1里
2、 按Alt+F11 打开VBA编辑器
3、 点击插入-模块-模块1
4、 双击模块1、把下面的代码复制到模块1后点击保存
5、 把表格保存为带宏文件.xlsm
6、 运行代码Alt+F8 选择【根据要求拆分表】
使用视频教程:
代码如下:
-------------------------------------
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 "Sheet1" Then
'把数据粘贴到sheet1表中
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
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Cells(i, l)
End If
'拷贝数据
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")
Sheet1.Cells(1, 1).Resize(rs, cs).AutoFilter
Sheet1.Select
MsgBox "已处理完毕"
领取专属 10元无门槛券
私享最新 技术干货