Excel拆分表格内容为多个工作表：代码图文步骤

想把Excel里的总表按某一列内容拆成多个独立工作表，用VBA可以说是最稳妥的做法：总表放在单独一个工作表里，按姓名、部门、区域、类别这类指定字段筛选，把每个字段对应的所有内容直接复制到同名新工作表就行。操作前记得先把文件另存为xlsm格式，原始文件的备份一定提前留好，别嫌麻烦。

先确认总表有表头和可拆分字段

总表第一行必须是表头，后面每一行对应一条完整数据记录。用来当拆分依据的列内容要规整统一，比如姓名、部门、区域、商品类别这类都可以；要是这一列里有空白单元格，拆出来的表很容易漏数据——所以，先把所有空白内容补全再跑代码，省得后面返工。

打开 VBA 模块粘贴拆分代码

按键盘上的 Alt + F11 就能调出VBA编辑器，依次点顶部菜单栏的「插入」-「模块」，把下面这段代码直接粘进去就行。代码里的 vcol = 2 表示按第2列拆分，想按部门、区域或其他列拆，把等号后面的数字改成对应列的序号就可以。

Sub SplitToSheets()    Dim ws As Worksheet, newWs As Worksheet    Dim lastRow As Long, lastCol As Long, vcol As Long    Dim dict As Object, key As Variant, i As Long    Dim rng As Range    Set ws = ActiveSheet    vcol = 2    lastRow = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column    Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol))    Set dict = CreateObject("Scripting.Dictionary")    For i = 2 To lastRow        If Len(ws.Cells(i, vcol).Value) > 0 Then            dict(ws.Cells(i, vcol).Value) = 1        End If    Next i    Application.ScreenUpdating = False    For Each key In dict.Keys        If Not SheetExists(CStr(key)) Then            Set newWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))            newWs.Name = Left(CStr(key), 31)        Else            Set newWs = Worksheets(CStr(key))            newWs.Cells.Clear        End If        rng.AutoFilter Field:=vcol, Criteria1:=key        rng.SpecialCells(xlCellTypeVisible).Copy newWs.Range("A1")        newWs.Columns.AutoFit    Next key    ws.AutoFilterMode = False    Application.ScreenUpdating = TrueEnd SubFunction SheetExists(ByVal sheetName As String) As Boolean    On Error Resume Next    SheetExists = Not Worksheets(sheetName) Is Nothing    On Error GoTo 0End Function

运行宏后检查拆分出来的工作表

切回Excel界面按 Alt + F8，选中 SplitToSheets 再点「运行」就可以。拆分完成后，底部工作表栏会多出一堆按拆分字段命名的新表；随便点开几个核对，检查表头、公式和所有记录是不是和总表对应上。注意Excel工作表名最多支持31个字符，要是拆分字段里有斜杠、星号这类系统不允许出现在表名里的非法字符，得先清理完字段内容再运行，不然代码会报错。