不要再用Ctrl C了，工作簿拆分、合并一键生成，工作再忙也要看……

VIP学员的问题，要将多个工作簿合并在同一个工作簿的多个工作表，再进行逆向操作，将多个工作表拆分成多个工作簿。

如果仅仅是3个，Ctrl+C还是很快的，但问题是，有可能是30个，甚至更多，那就要按到手酸。

刚好前几天也有读者留言要类似的功能，今天，卢子就分享2个模板，让你轻松一键实现拆分、合并。

1.多个工作表拆分成多个工作簿

在VBA后台，运行代码，观察左边，你会看到一个个工作簿拆分出来，稍等几秒，就拆分好了。

Sub 拆分工作表()

    Dim b As Worksheet

    Excel.Application.ScreenUpdating = False

    For Each b In Sheets

        b.Copy

        Excel.ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & b.Name & ".xlsx"

        Excel.ActiveWorkbook.Close

    Next

    Excel.Application.ScreenUpdating = True

End Sub

前一阵子搞了一个VBA系列专题，估计有的读者已经忘了，这里再说明一下如何使用代码？

复制代码，点开发工具，VB编辑器，插入模板，将代码粘贴进去。

2.多个工作簿合并成多个工作表

将Excel不加班多工作簿合并模板放在同一个文件夹内。

复制代码，点开发工具，VB编辑器，插入模板，将代码粘贴进去。

Sub 合并工作簿()

    Dim Wb As Workbook, MyPath As String, File, Sh_n As String

    Application.ScreenUpdating = False

    Rem 关闭屏幕刷新

    MyPath$ = ThisWorkbook.Path & "\"

    Rem 获取当前工作簿路径

    File = Dir(MyPath & "*.xls*")

    Rem 获取路径下所有Excel文件

    Do While File <> "" '遍历所有文件

        If File <> ThisWorkbook.Name Then '不合并当前工作簿

            Set Wb = Workbooks.Open(MyPath & File)

            Rem 依次打开工作簿

            Sh_n = StrReverse(Mid(StrReverse(Wb.Name), InStr(StrReverse(Wb.Name), ".") + 1))

            Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

            ActiveSheet.Name = Sh_n

            Rem 将第一个表复制到当前工作簿的最后一个工作表

            Wb.Close False '关闭工作簿 不保存

        End If

        File = Dir

        Rem 循环下一个工作簿

    Loop

    Application.ScreenUpdating = False

    Rem 打开屏幕刷

End Sub

VBA可以直接在后台运行，也可以直接插入一个按钮或者图片来运行。

在开发工具，插入一个按钮，并重命名。

点按钮运行，稍等片刻，就合并完成。

模板在手，以后不管要拆分、合并，都是轻轻松松一键搞定，再也不用为这些事发愁。

推荐：别再复制粘贴了，几十个工作表合并最简单的办法，一学就会！

上篇：一样的复制粘贴，为什么别人做出来的表格又快又好？

你怕不怕长期跟卢子学习，以后一天的工作几分钟做完？

作者：卢子，清华畅销书作者，《Excel效率手册 早做完，不加班》系列丛书创始人，个人公众号：Excel不加班（ID：Excelbujiaban）