拆分工作表，如果只会用VBA你就out了

按照某列将一张工作表拆分到多个工作表，这是一个很实用的技巧。

比如：已经计算好的各地区的销售明细，怎么按照地区拆分到各个工作表中？

如果会使用VBA的同学，一键就能生成

不使用VBA，还能做吗？

利用透视表按照关键字段就可以拆分

01

添加辅助列

02

建立透视表

03

设置透视表区域

辅助列用鼠标拖拉到'筛选'区域，其他列都拖拉到'行'区域

04

设置报表布局

按下图设置报表布局，并禁用分类汇总和总计

05

显示筛选页

菜单选择'分析'-'选项'-'显示筛选页'

并按Shift选择工作表，把表格都转成数值。

用'显示报表筛选页'功能，便可拆分到多张工作表。

操作很简单，练几次就可以上手了。

如果想灵活选择某列或一键生成，当然是选择VBA。

两者各有优点，下面附上通用的拆分代码，供大家学习。

按Alt+F11，插入模块，把代码粘贴到模块中

Sub 按指定列分组拆分数据() Application.ScreenUpdating = False Application.DisplayAlerts = False Set sh = ActiveSheet For i = Sheets.Count To 1 Step -1 If Sheets(i).Name <> sh.Name Then Sheets(i).Delete End If Next i Dim splitColumnRange As Range Set splitColumnRange = Application.InputBox(prompt:='请选择拆分的列：选择任何一个该列的单元格即可', Type:=8) Dim columnNumToSplit As Long n = splitColumnRange.Column Set Rng = splitColumnRange.CurrentRegion arr = Rng Rng.Sort Key1:=Rng(1, n), Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1 brr = Rng(1, 1).Resize(UBound(arr) + 1, UBound(arr, 2)) ReDim crr(1 To UBound(brr), 1 To UBound(brr, 2)) x = 1 For i = 2 To UBound(brr) - 1 x = x + 1 For j = 1 To UBound(brr, 2) brr(x, j) = brr(i, j) Next If brr(i, n) <> brr(i + 1, n) Then Set sht = Sheets.Add(after:=Sheets(Sheets.Count)) sht.Name = brr(i, n) sht.Range('a1').Resize(x, UBound(brr, 2)) = brr x = 1 End If Next splitColumnRange.CurrentRegion = arr Application.ScreenUpdating = True Application.DisplayAlerts = TrueEnd Sub

好了，今天就分享到这，有问题可以给我留言。