在工作中，总是会遇到这样一个需求。一张 Excel 中存在多条记录。其中某一列存贮分公司名称，需要按照分公司名称分别存贮为不同的 Excel 表。如果手工处理。分公司少还好做，但是如果数据量很大，分公司数量也较多，而且还是每天必须做的工作，我们一定会考虑使用更方便的方法。VBA 可以让 Excel 变得非常强大。下面就介绍一下如何利用 VBA 代码实现上述拆分工作。

首先感谢 Baidu，我也是在通过百度查找了很多资料后最终确认的 VBA 代码。

需求为：根据G的的分公司名称拆分表格，并单独存储。如下图

操作方法如下：

右键单击数据所在页的 sheet 标签。选择’查看代码’。（或者按快捷键 ALT + F11）复制下面的代码到新打开的窗口中。点击复制完代码的页面工具栏中的‘运行->运行子过程/用户窗体’。（或点击快捷键F5）执行后会弹出窗口提示“请输入拆分工作表的名称：”此时输入存储数据页面的工作簿名称（通常为“sheet1”）点击确认。弹出窗口提示“请输入拆分依据的列号（如A）：”此时按照我们的示例输入‘G’。弹出窗口提示“请输入拆分的开始行：”此时按照2（说明：行1为标题，从行2开始为数据。因此从第二行开始拆分）。点击确认开始拆分。弹出“拆分工作表完成”及结束。找到数据文件存储的路径。会发现一个名为“拆分出的表格”的文件夹。文件夹中已经保存好拆分完的表格了。

‘来自Geeker Xu加工整理’Sub XXX_Click()‘输入用户想要拆分的工作表Dim sheet_namesheet_name = Application.InputBox(“请输入拆分工作表的名称：”)Worksheets(sheet_name).Select‘输入获取拆分需要的条件列Dim col_namecol_name = Application.InputBox(“请输入拆分依据的列号(如A):”)‘输入拆分的开始行，要求输入的是数字Dim start_row As Integerstart_row = Application.InputBox(prompt:=”请输入拆分的开始行:”, Type:=1)‘暂停屏幕更新Application.ScreenUpdating = False‘工作表的总行数Dim end_rowend_row = Worksheets(sheet_name).Range(“A65536”).End(xlUp).Row‘遍历计算所有拆分表，每个拆分表的格式为”表名称,表行数”‘对于二维数组，ReDim只能扩充最后一维，因此sheet_map行不变，扩充列Dim sheet_map(), sheet_indexReDim sheet_map(1, 0)sheet_map(0, 0) = Range(col_name & start_row).Valuesheet_map(1, 0) = 1sheet_index = 0With Worksheets(sheet_name)Dim row_count, temp, irow_count = 0For i = start_row + 1 To end_rowtemp = Range(col_name & i).ValueIf temp = Range(col_name & (i – 1)).Value Thensheet_map(1, sheet_index) = sheet_map(1, sheet_index) + 1ElseReDim Preserve sheet_map(1, sheet_index + 1)sheet_index = sheet_index + 1sheet_map(0, sheet_index) = tempsheet_map(1, sheet_index) = 1End IfNextEnd With‘根据前面计算的拆分表，拆分成单个文件Dim row_indexrow_index = start_rowFor i = 0 To sheet_indexWorkbooks.Add‘创建最终数据文件夹Dim dir_namedir_name = ThisWorkbook.Path & “\拆分出的表格\”If Dir(dir_name, vbDirectory) = “” ThenMkDir (dir_name)End If‘创建新工作簿Dim workbook_pathworkbook_path = ThisWorkbook.Path & “\拆分出的表格\” & sheet_map(0, i) & “.xlsx”ActiveWorkbook.SaveAs workbook_pathActiveSheet.Name = sheet_map(0, i)‘激活当前工作簿，ThisWorkbook表示当前跑代码的工作簿ThisWorkbook.Activate‘拷贝条目数据(即最前面不需要拆分的数据行)Dim row_rangerow_range = 1 & “:” & (start_row – 1)Worksheets(sheet_name).Rows(row_range).CopyWorkbooks(sheet_map(0, i) & “.xlsx”).Sheets(1).Range(“A1”).PasteSpecial‘拷贝拆分表的专属数据row_range = row_index & “:” & (row_index + sheet_map(1, i) – 1)Worksheets(sheet_name).Rows(row_range).CopyWorkbooks(sheet_map(0, i) & “.xlsx”).Sheets(1).Range(“A” & start_row).PasteSpecialrow_index = row_index + sheet_map(1, i)‘保存文件Workbooks(sheet_map(0, i) & “.xlsx”).Close SaveChanges:=TrueNext‘进行屏幕更新Application.ScreenUpdating = TrueMsgBox “拆分工作表完成”End Sub

希望Geeker Xu 的分享可以对您的工作带来方便。

了解更多信息可以关注头条号：极客许的技术分享

或 个人博客https://geekerxu

业务背景

很难想象，这么常用的一个拆分功能，在Excel催化剂中却迟迟没有见有实现，说句心理话，这些功能看似很实用好用。但实在不是一个本该有的功能，是因为Excel界一大片低级用户，甚至中高级用户，没有对Excel数据管理的最科学方法论，以致在错误的方法论指引下，最终产生一系列畸形需求。

改变现状，谈何容易，在工作场所中，也不是自己一个人能够左右其他人的不正确的作法。能改变一个算一个，当有这些一个工作薄里存有大量相同类型的工作表时，当面临要拆分来分享数据时，此时没有这个拆分功能，还是诸多地不便，最后只能低下头来，把这些伪需求也给做出来，有此功能并不代表Excel催化剂认可并接爱这些制表行为。

Excel催化剂始终给大家提供的不止于某个功能的实现，更想带给大家Excel的数据处理、数据分析上的最佳实践科学方法论，这些估计市场上所有视频、图书都少有人认真去讲述。

功能实现

拆分工作薄内的工作表，在此做了最大的场景设想，将所有会面对的情形，都一一地做了处理，最终可应对众多的实际需要。具体有以下的情形

每个工作表以一个工作薄存放，并且工作薄文件名称为工作表的名称每个工作表以一个工作薄存放，但工作薄名称不同于工作表名称（需稍加上前缀或后缀以更好地标识数据内容）新生成的工作薄，需要在原工作薄上的多个工作表，如季度的数据，可能想要把3个月份的工作表都包含，即新的工作薄包含3个工作表。部分工作表没必要生成新的工作薄，可忽略它不处理部分工作表是固定的工作表，需要在新生成的工作薄里都附带上，例如有一个工作表专门用于对数据结构、数据来源之类的额外信息说明或数据使用的额外说明。生成的最终文件对文件类型有要求，需要用xls或xlsx格式。

一般常有的插件，仅能满足1和4这两种情形，对其他情形无能为力。而Excel催化剂想你所想，把以上六点所提及的全覆盖，并且操作步骤趋于最简单化。

具体操作

点击【配置工作表】按钮

切换到需要拆分的工作薄上，点击【配置工作表】按钮

填定生成的工作薄路径

使用自定义函数PathCombine或其他方式，快速生成最终的目标工作薄路径。通过【新工作薄全路径】的设定，可满足上述6点提及的问题，灵活度高，设定容易

情形2实现，工作薄名称不同工作表，见下图

情形3实现，一个工作薄多个工作表，见下图

情形4实现，不需导出新工作薄的，直接留空或使用自动筛选过滤隐藏。

情形5实现，固定新工作薄都要输出，输入999即可。

情形6实现，不同文件类型，甚至可单独设定不一样。

拆分工作薄

点击第2步的【拆分工作薄】即可完成。

总结

玩摄影的人，不可能满足于一台傻瓜式相机或一台手机，单反相机是必备，同样地，我们要应对各式各样的场景，插件的通用性就非常有必要，此篇给大家展示了堪比单反相机搬地灵活配置，最终满足各式各样的场景，同时在易用性方面尽可能地满足到位。

最后还是那句话，Excel最佳实践非常重要，没有它作前提，后续要做的各种无意义的事情多了去。工作薄拆分是我定义的无意义的事情之一。

1.原始数据表如下（名称为：数据源），需要根据B列人员姓名拆分成每个人一个工作表。

2.点击【开发工具】-【Visual Basic】或者Alt+F11的快捷键进入VBE编辑界面。

3.如下图所示插入一个新的模块。

4.如下图，粘贴下列代码在模块中：

Sub CFGZB()

    Dim myRange As Variant

    Dim myArray

    Dim titleRange As Range

    Dim title As String

    Dim columnNum As Integer

    myRange = Application.InputBox(prompt:="请选择标题行：", Type:=8)

    myArray = WorksheetFunction.Transpose(myRange)

    Set titleRange = Application.InputBox(prompt:="请选择拆分的表头，必须是第一行，且为一个单元格，如：“姓名”", Type:=8)

    title = titleRange.Value

    columnNum = titleRange.Column

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    Dim i&, Myr&, Arr, num&

    Dim d, k

    For i = Sheets.Count To 1 Step -1

        If Sheets(i).Name <> "数据源" Then

            Sheets(i).Delete

        End If

    Next i

    Set d = CreateObject("Scripting.Dictionary")

    Myr = Worksheets("数据源").UsedRange.Rows.Count

    Arr = Worksheets("数据源").Range(Cells(2, columnNum), Cells(Myr, columnNum))

    For i = 1 To UBound(Arr)

        d(Arr(i, 1)) = ""

    Next

    k = d.keys

    For i = 0 To UBound(k)

        Set conn = CreateObject("adodb.connection")

        conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName

        Sql = "select * from [数据源$] where " & title & " = '" & k(i) & "'"

        Worksheets.Add after:=Sheets(Sheets.Count)

        With ActiveSheet

            .Name = k(i)

            For num = 1 To UBound(myArray)

                .Cells(1, num) = myArray(num, 1)

            Next num

            .Range("A2").CopyFromRecordset conn.Execute(Sql)

        End With

        Sheets(1).Select

        Sheets(1).Cells.Select

        Selection.Copy

        Worksheets(Sheets.Count).Activate

        ActiveSheet.Cells.Select

        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

                               SkipBlanks:=False, Transpose:=False

        Application.CutCopyMode = False

    Next i

    conn.Close

    Set conn = Nothing

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

End Sub

5.如下图所示，插入一个控件按钮，并指定宏到刚才插入的模块代码。

6.点击插入的按钮控件，根据提示选择标题行和要拆分的列字段，本例选择“姓名”字段拆分，当然也可以选择C列的“名称”进行拆分，看实际需求。

7.代码运行完毕后在工作簿后面会出现很多工作表，每个工作表都是单独一个人的数据。具体如下图所示：

注意：

1）原始数据表要从第一行开始有数据，并且不能有合并单元格；

2）打开工作簿时需要开启宏，否则将无法运行代码。

（本文内容由百度知道网友茗童贡献）

工作时候在ERP系统中导出的数据,所有的内容都在同一列中,那怎么筛选?怎么汇总? 如何把一列中的一部分拆分成两列或多列？如何把单元格中括号前面的数据如何批量提取？小编来告诉你90%以上人都不知道的快速拆分Excel表格的神器~

选择需要拆分的列,切换到【开始】选项卡，选择【数据工具】组中的分列按钮，弹出【文本分列向导】对话框。

分隔符号：根据需要选用特征值，如Tab键、分号、逗号、空格、如果都没有就勾选其他，在后面的方框中输入相应的特征值。也可以用其中的文字作为分隔符号，需要注意的是，方框内职能填写一个字或者符号。而且使用特征值拆分后，该特征值在完成分列后随之消失。

固定宽度：数据没有明显的特征值，而且数据是连续的，可以选择固定宽度。在数据预览中用鼠标左键单击要拆分的位置，出现一条分列线。按住分列线并拖动位置，可以移动分列线位置。双击分列线可清除分列线。

以上。

希望大家在阅读之余，多加练习办公软件Office的使用，提高我们的工作效率，成为职场高效率的一员。我将在每周都进行内容更新，大家一起学习，共同进步。

excel使用技巧大全表格的拆分对很多人来说都是一件难事，大家都想到的第一个方法就是复制和粘贴，或者用代码解决，其实，EXCEL有自带功能的，可以快速的帮你实现拆分。今天就给大家介绍一下这种方法，不需要编写任何的代码，一下就学会了。

例如下面我们要把这个表格拆分成多个工作表。

要把A列的销售部门，按照部门的名称进行分表。这时候，传统的方法就是插表，再进行复制粘贴。其实，解决这个问题，我们只需要学会运用Excel自带的数据透视表功能就可以。

首先，创建一个数据透视表，选中我们有用的数据区域，接着插入数据透视表。记住除了销售部门名称外，其他都要添加行标签。

插入完之后，我们就调整格式，选中区域，在浮动选项卡——布局分分类汇总——不显示，报表布局那里在选择报个形式，在去分析选项卡里面把+/- 键进行取消。

第三步，就是最为关键的一步，进行拆分表格，在透视表工具中，按选项—显示报表筛选页—确定，那么拆分就完成。

第四部删除数据透视表格式，这个比较简单。按shift连选表格，然后根据下面的方法，复制粘贴相应的值，最后删除前2行和取消工作表就可以完成。

第二个例子，批量建设相同的表。

学了如何拆分表，现在学学如何批量新建表格，具体操作如下图：

工作中，我们经常遇到这样的问题，比如：如何将一个工作表按类别快速拆分成多个工作表？如何将一个工作簿的多个工作表快速拆分另存为多个工作簿？下面就用案例来说明如何解决这两个问题。

第1个问题：有关工作表快速拆分的问题。案例：将员工花名册按部门拆分成多个工作表。

批量拆分工作表的方法：数据透视表

1、创建数据透视表，首先按将普通的表格（员工基本情况表）转换成数据透视表。

具体方法：【插入】→【数据透视表】→在数据透视表字段中将部门拖选到筛选区域，勾选（或拖选）其他字段到行（Excel2016在勾选日期字段时会自动添加【年】和【季度】字段，如果不需要，您可以将前面的√取消选择）。

2、调整数据透视表格式。

默认条件下创建的透视表看起来不符合我们的要求，需要进行一些调整，让数据透视表更接近我们员工花名册的格式。

具体方法：点击数据透视表任何位置→【数据透视表工具】→【设计】→【分类汇总】不显示分类汇总→【总计】对行和列禁用→【报表布局】以表格形式显示。

友情提醒：

① 有时数据透视表会自动将日期变成月份格式，我们只要右击鼠标，选择【取消组合】就可以显示正常的日期了。

②有时日期会显示成####，这是因为字符宽度超出了列宽，我们只要把列宽调大就可以了。快速调整列宽适应单元格字符长度的快捷方法是选中要调整的列，将鼠标指针放到列号与列号之间，当指针变成十字后双击鼠标左键即可。

③有时身份证会显示不对，我们只要设置单元格格式为自定义格式“0”即可。

3、按部门拆分工作表

具体方法：【数据透视表工具】→【分析】→【选项】→【显示报表筛选页】→【部门】→【确定】。动画演示如下：

4、规范工作表格式。前面已将员工基本情况表数据源已按部门拆分成7个工作表，为了下一步工作表拆分，我们先将工作表格式进行规范。

具体方法：全选工作表→右键【复制】→【粘贴成值】→删除第1和第2行（数据透视表不粘贴成值不能删除第1和第2行，调整日期格式和身份证格式。动画演示如下：

第2个问题：将一个工作簿的多个工作表快速拆分另存为多个工作簿。案例，将我们刚刚用数据透视表按部门拆分的工作表批量另存为多个工作簿。

1、导入模块文件。

具体方法：按快捷键Alt+F11，打开工程窗口→【导入文件】→选择模块文件（.bas）→【打开】→关闭VBA 编辑器。

2、另存为工作簿。

①选中需要另存的工作表。选择连续的工作表可以按shift键选择第一个工作表，再选择最后一个工作表，选择不连续的工作表可以按住ctrl键点选工作表。

②【开发工具】→【宏】→选择“拆分工作表”宏→执行。

完成上述操作后，您就可以在当前工作表所在路径的文件夹中找到一个名为【拆分好的工作表】的文件夹，被另存的工作簿就存在这个文件夹里，工作簿名称默认为工作表的名称。

如果觉得好用，请关注、点赞、评论、转发，你的支持是我坚持的动力，更多的EXCEL技能，大家可以关注“EXCEL学习微课堂”。如需批量拆分工作表到工作簿VBA代码文件，请关注、转发后私信联系我。

在工作中，我们在Excel的中处理数据的时候，经常可能存在需要快速将各个分表的数据按照一定的规则合并成一张总表中，但有时我们又需要快速将总表的数据按照约定拆分成各个工作表。

对于这种重复性很强的工作，我们其实可以考虑一键操作，因为数据的处理是有规律的。当然这个要求源数据必须是完整的。

如下图为我们的源数据区域，我们需要按照B列的部门进行数据的拆分到不用的工作表当中，并且以相应的部门为工作表名称。

操作动画如下：

该代码可以保留总表的格式，但无法保留总表的公式。其实代码也是非常的简单的语法堆积出来的，都在最最简单的循环和字典，数组和一些功能代码组合而成，其实VBA真的非常简单。

代码参考如下：

以上就是今天要和大家分享的技巧，希望对大家有所帮助，欢迎大家帮忙转发，谢谢！

祝各位一天好心情！

Excel中每一个方法都有特定的用途，不是他们没有用处，只是你不了解或者暂时用不着，建议你收藏起来，万一哪天用着呢？

案例

：如图所示，为某公司市场部的销售业绩。现在为了需要把销售额表，根据

销售地

拆分为多个sheet表，且表名为

名。如何进行操作呢？

职场小白思路：首先对数据按照销售地进行排序，然后 开始新建多个sheet，然后复制，黏贴，复制，黏贴......效率及其低下

雷哥做法

：

Step1

：新建一个数据透视表，注意：

作为筛选项

Step2

：单击透视表任一单元格，点击 分析——选项——显示报表筛选页——确定 即可。

下面就是见证奇迹的时刻啦，看到文件底部，出来很多工作表，北京，成都，......

比复制，黏贴，复制等快了不知道多少倍。

雷哥，office发烧友。欢迎互动交流学习

在对Excel表格进行数据处理时，有时需要将一张表格，按某个类别进行拆分成若干个表格。今天就跟大家分享一种快速拆分表格的方法。

以下图中的表格为例，将该表格，按地区拆分成若干个表格。

以下就是拆分的详细步骤

1，生产数据透视表

具体步骤：

选中数据源表格，点击菜单“插入”中的“数据透视表”将“地区”字段，添加到筛选器中将其他所有字段，都添加到行标签中生成完数据透视表后，点击菜单 “设计” -- “表格布局” -- “以表格形式显示”

具体操作如下：

2，拆分表格

操作步骤：

选中数据透视表，点击菜单 “分析” -- “数据透视表” -- “选项” -- “显示报表筛选页”在弹出的“显示报表筛选页”对话框中，选中“地区”后，点击“确定”按钮

这样，原数据透视表，就被拆分成按地区分类的数个页面了。

具体操作如下：

3，整理表格

此时，拆分后还是数据透视表，此时需要将这些数据透视表转换成表格。

步骤：

选中所有拆分后页面复制 -- 选择性粘贴（数值） -- 删除前两行

这样表格就拆分完成了。

以上就是快速拆分Excel表格的方法。今天的分享就到这里，明天继续

第一步：插入数据透视表

1.鼠标放在数据区，插入数据透视表，如下图：

2.因为只是拆分工作表，不进行计算，所以此处“值”区域空白，如下图：

第二步：设计数据透视表

不显示分类汇总，如下图：

2.以表格形式显示数据，如下图：

3.显示报表筛选页，如下图：

4.筛选页字段为区域，如下图：

第三步：拆分完成

1.拆分成四个按地区独立显示的工作表，如下图：

2.以数据透视表拆分方式拆分的工作表显示为数据透视表格式，如果想以表格形式显示数据，可以双击数据透视表右下角单元格，如下图：

3.以表格形式显示数据，如下图：