Question

excel中将一张表中数据拆分成多个工作表，按部门不相同的拆分成单个工作表，且单个工作表名及为部门

销售部门 订单号 下单日期 客户名称
北京办 2012010055 1-10 扬安机电安装有限公司
北京办 2012020013 2-3 北京世纪明宇环境工程科技有限公司
北京办 2012040220 4-19 北京办
北京办 2012040333 4-28 北京办
北京办 2012050155 5-14 北京办
北京办 2012050386 5-30 北京办
北京办 2012060126 6-8 北京世纪明宇环境工程科技有限公司
成都办 2012010050 1-9 成都庆烨安装工程有限责任公司
成都办 2012020015 2-3 四川天翔空调设备有限公司
成都办 2012020204 2-25 四川天翔空调设备有限公司
成都办 2012030252 3-24 成都庆烨安装工程有限责任公司
成都办 2012040257 4-24 四川天翔空调设备有限公司
成都办 2012050044 5-4 成都庆烨安装工程有限责任公司
邓明开 2012010041 1-9 中山航艺冷气工程
邓明开 2012020144 2-18 佛山市南海嘉逸酒店有限公司
邓明开 2012020152 2-20 佛山市大沥何球冷气有限公司
最后每个工作薄的名称都是销售部门，数据就是销售部门所对应的所有数据。

Answer 1

方法和详细的操作步骤如下：

1、第一步，在excel加载项中，选择“方方格子”选项，然后选择“汇总拆分”选项，见下图，转到下面的步骤。

2、第二步，执行完上面的操作之后，在下拉菜单中，选择“拆分工作簿”选项，见下图，转到下面的步骤。

3、第三步，执行完上面的操作之后，设置要拆分的工作表以及需要存储的位置，然后单击“确定”，见下图，转到下面的步骤。

4、第四步，执行完上面的操作之后，将提示“立即查看文件”，见下图，转到下面的步骤。

5、第五步，执行完上面的操作之后，在指定的文件夹中，可以看到拆分的表格并完成拆分，见下图。这样，就解决了这个问题了。

Answer 2

在工作表名称上点右键选查看代码,粘贴以下代码到弹出窗口.关闭弹出窗口 ALT+F8选中该宏执行

Sub 拆分工作表()
Application.ScreenUpdating = False
Dim rng As Range, arr()
endrow = Range("A65536").End(xlUp).Row
ReDim arr(2, 0)
arr(0, 0) = Range("A2").Value
arr(1, 0) = Range("A2").Row
arr(2, 0) = Range("A2").Row
L = 0
For i = 2 To endrow
temp = Range("A" & i).Value
For ii = i + 1 To endrow
With Range("A" & ii)
If .Value = temp Then
arr(2, L) = .Row
Else
L = L + 1
ReDim Preserve arr(2, L)
arr(0, L) = .Value
arr(1, L) = .Row
arr(2, L) = .Row
i = .Row - 1
Exit For
End If
End With
Next
Next
For i = 0 To L
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & arr(0, i)
ActiveSheet.Name = arr(0, i)
ActiveSheet.Range("A:C").ColumnWidth = 10
ActiveSheet.Range("A:C").HorizontalAlignment = xlCenter
ActiveSheet.Range("A:C").VerticalAlignment = xlCenter
ActiveSheet.Range("C:C").NumberFormatLocal = "m-d"
ActiveSheet.Range("D:D").ColumnWidth = 30
ThisWorkbook.Activate
Workbooks(arr(0, i) & ".xls").Sheets(1).Rows(1).Value = Sheet1.Rows(1).Value
For bc = arr(1, i) To arr(2, i)
Workbooks(arr(0, i) & ".xls").Sheets(1).Rows(bc - arr(1, i) + 2).Value = Sheet1.Rows(bc).Value
Next
Workbooks(arr(0, i) & ".xls").Close SaveChanges:=True
Next
Application.ScreenUpdating = True
MsgBox "拆分工作表完成!" & vbCrLf & "在当前工作薄路径下创建工作薄:" & L + 1 & "个."
End Sub

Answer 3

如何将一张工作表拆分成多个工作表？

Answer 4

可以把文件发过来,我帮你拆分,几分钟搞定463927719