【职场那点事】Excel总表Sheet按内容分类，拆分成多个工作簿文件，一步到位！

Excel情报局

Excel职场联盟

生产挖掘分享Excel基础技能

Excel爱好者大本营

用1%的Excel基础搞定99%的职场问题

做一个超级实用的Excel公众号

Excel是门手艺玩转需要勇气

数万Excel爱好者聚集地

01

职场永恒的拆分问题 

Excel情报局

今天我们来讲一个职场上使用Excel永恒的高频率拆分话题：

Excel总表Sheet按内容分类，拆分成多个工作簿文件。

如下图所示：

在一个文件夹内，有一个Excel工作簿文件“Excel情报局 总表”，我们打开这个工作簿，发现工作簿内部有一个Sheet总表，“总表”上面存放了每日的车间产量数据明细。

现在我们想要依据A列车间的分类，将Sheet总表拆分成以车间命名的多个工作簿文件，如下图所示：

02

总体思路 

Excel情报局

我们可以通过“两步走”的战略，来实现这个效果。

第一步：

首先我们需要依据Sheet总表中，A列的车间分类，拆分成多个工作表，储存在“Excel情报局 总表”工作簿中。

第二步：

然后我们再将“Excel情报局 总表”工作簿中的多个工作表拆分成多个独立的工作簿文件。放置在一个文件夹里面。

03

详细步骤分析 

Excel情报局

首先我们右击“总表”工作表名称标签，点击“查看代码”，然后将一段VBA代码复制粘贴到代码编辑窗口内。

代码如下：

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 = TrueEnd Sub


注意：

复制粘贴代码前请注意：

代码中有4处“总表”名称出现，需要根据我们自己表格的具体情况，替换成实际的工作表名称，因为我的工作表总表名称为“总表”，所以代码的这四个地方显示的是“总表”。一定要灵活修改，不然会提示错误！

点击“运行”按钮。

弹出：请选择标题行

我们输入对应的标题行区域：$A$1:$C$1

点击确定后再次弹出：请选择需要拆分的表头

继续输入我们的分类列，即车间列的标题单元格位置$A$1

最后点击确定，完成总表的拆分工作。

然后我们随意再另外找一个工作表，继续右击工作表名称标签，点击“查看代码”，将另一段VBA代码复制粘贴到VBA编辑窗口内。

代码如下：

Private Sub 分拆工作表()Dim sht As WorksheetDim MyBook As WorkbookSet MyBook = ActiveWorkbookFor Each sht In MyBook.Sheetssht.CopyActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & sht.Name, FileFormat:=xlNormal '将工作簿另存为EXCEL默认格式ActiveWorkbook.CloseNextMsgBox "文件已经被分拆完毕!"End Sub

然后继续点击“运行”按钮，运行代码。

运行代码过程中可能部分版本的Excel会提示兼容性检查的提示框，直接点击“继续”往下运行即可。最后会弹出“文件已经成功拆分完毕”的提示框。

最后我们看到文件夹中拆分好的工作簿文件已经整齐的显示出来了。

点击打开各个工作簿，里面存放了对应车间的产量信息。

阅读完文章之后，希望小伙伴们在文章底部帮小编点亮[在看]并分享转发到[朋友圈]，坚持持续分享的路上需要有你们的鼓励与支持！