Excel工作表拆分，如果方法掌握不得当，真的十分麻烦。
其实有很多办法实现，这里运用vba代码处理，一键式操作，方便快捷。
拆分表操作
左侧为操作区域，所有操作都在这里进行。
1、列表框
列表框里列出要以哪一列作为拆分条件，比如：本例以“部门”为拆分列，拆分后的表以各“部门”保存工作表。
2、导入工作表按钮
直接导入要拆分的工作表，这样就实现了任何表都可以在这里进行拆分。有一个小问题就是，拆分表第一行即是字段行，不要带标题，不然导入工作表后，列表框里无法选择拆分列。
导入对话框
导入对话框功能是十分必要的，从这里可以导入要进行拆分的工作表，通过文件选择框进行选择表，所以无论表在什么地方存储都可以实现拆分工作。
其主要有了文件对话框功能选择工作表 Application.FileDialog(msoFileDialogFilePicker)
3、开始拆分按钮
这个按钮就没什么可解释了，直接执行拆分工作，其后台有一些代码来运行，通常用户不需要知道都做了些什么，反正我们要个结果就行了。
拆分后的表
拆分后的工作表以同“部门”信息保存到一个表里，这样做就可以分发到各部门了。
如做考勤记录，工资管理，任务分配等，对部门分表的操作都可以实现。
当然，也可以按不同的列来进行拆分，如姓名，单位，单价，数量，型号等等，只要你想就可以实现。
VBA代码
代码比较凌乱，主要是一些条件逻辑可能比较多，也没有做过多的函数分解，所以统一在一个代码段里，显得可读性不是十分友好。
不过，为了追求结果，其它就不管了 ，因为也没想过再修改代码。
代码片段
Private Sub CommandButton2_Click()
'''导入工作表
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim iRow As Integer, iCol As Integer
Dim opW As Workbook
Dim wkName As String
Dim fobj As Object
Set fobj = Application.FileDialog(msoFileDialogFilePicker)
With fobj
.Filters.Clear
.AllowMultiSelect = False
.Filters.Add "Excel File", "*.xls,*.xlsx"
.Filters.Add "All File", "*.*"
If fobj.Show = -1 Then
Workbooks.Open (.SelectedItems(1))
Set opW = ActiveWorkbook
ActiveSheet.UsedRange.Copy
Me.Activate
iRow = Me.Range("B65535").End(xlUp).Row
iCol = Me.Range("ZZ2").End(xlToLeft).Column
If iRow >= 2 Or iCol >= 2 Then
Me.Range(Cells(2, 2), Cells(iRow, iCol)).Value = ""
End If
'''''''''''''''''''''''''''
Me.Range("B2").Select
With Selection
.PasteSpecial
End With
End If
End With
'''''''''''''''' 添加列表框
iCol = Me.Range("ZZ2").End(xlToLeft).Column
Me.OLEObjects("ListBox1").Object.Clear
Dim i As Integer
For i = 2 To iCol
Me.OLEObjects("ListBox1").Object.AddItem Me.Cells(2, i).Value
Next i
If Not opW Is Nothing Then opW.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
欢迎关注江觅
分享各类Excel学习经验
