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

Sub 合并工作簿()

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

    Application.ScreenUpdating = False

    Rem 關(guān)閉屏幕刷新

    MyPath$ = ThisWorkbook.Path & "\"

    Rem 獲取當(dāng)前工作簿路徑

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

    Rem 獲取路徑下所有Excel文件

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

        If File <> ThisWorkbook.Name Then '不合并當(dāng)前工作簿

            Set Wb = Workbooks.Open(MyPath & File)

            Rem 依次打開(kāi)工作簿

            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 將第一個(gè)表復(fù)制到當(dāng)前工作簿的最后一個(gè)工作表

            Wb.Close False '關(guān)閉工作簿 不保存

        End If

        File = Dir

        Rem 循環(huán)下一個(gè)工作簿

    Loop

    Application.ScreenUpdating = False

    Rem 打開(kāi)屏幕刷

End Sub

模板在手，以后不管要拆分、合并，都是輕輕松松一鍵搞定，再也不用為這些事發(fā)愁。

推薦：別再?gòu)?fù)制粘貼了，幾十個(gè)工作表合并最簡(jiǎn)單的辦法，一學(xué)就會(huì)！

上篇：一樣的復(fù)制粘貼，為什么別人做出來(lái)的表格又快又好？

你怕不怕長(zhǎng)期跟盧子學(xué)習(xí)，以后一天的工作幾分鐘做完？