拆分工作表，如果只会用VBA你就out了|rng|vba|代码|工作表|拆分

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

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

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

不使用VBA，还能做吗？

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

0 1

添加辅助列

0 2

建立透视表

0 3

设置透视表区域

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

0 4

设置报表布局

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

0 5

显示筛选页

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

并按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 = True End Sub