一个Excel工作簿含有多个工作表，我要拆分成多个工作簿（一表一簿）分别放在桌面上怎么操作？反之呢

Question

如题所述

Answer 1

要用VBA ， 例如拆分的：

Alt+F11 视图--代码窗口，
把如下复制进去（如果复制进去不换行，复制到Word 再复制进去)   按F5运行即可
最好把这个Excel 放到一个文件夹内操作, 因为默认生成到当前文件夹，

合并的 ，看你要怎么合并

Sub fencun()
Application.ScreenUpdating = False
b = Sheets.Count
For i = 1 To b
Sheets(i).Copy
a = ThisWorkbook.Worksheets(i).Name
With ActiveWorkbook
.SaveAs Filename:=ThisWorkbook.Path & "\" & a & ".xls"
.Close
End With
Next i
Application.ScreenUpdating = true
End Sub

Answer 2

手工操作方法，在每个工作表上点鼠标右键选择【移动或复制】然后复制到新工作簿，最后另存为，如果表太多操作比较心烦，可以使用下面的宏：

Sub 宏1()
    For Each st In Sheets
        st.Copy
        ActiveWorkBook.SaveAs st.Name
        ActiveWorkBook.Close '如果保存后不关闭就删除此行
    Next st
End Sub

本回答被提问者采纳

Answer 3

右键，会有菜单出来，选择移动或复制工作表

追问

谢谢，原来这么简单....工作簿不能合并的吧

Answer 4

这个用代码一键来完成。在你的工作簿vbe窗口，新建一个模块，将以下代码复制进去，然后点击运行，就可以实现工作簿的拆分。
Sub 拆分到工作簿()
Dim wk As Workbook, ss$, k%
Application.DisplayAlerts = False
For Each sht In Worksheets
Set wk = Workbooks.Add
k = k + 1
Workbooks(1).Sheets(k).Copy Workbooks(2).Sheets(1)
ss = ThisWorkbook.Path & "\" & sht.Name & ".xlsx"
wk.SaveAs ss
wk.Close
Next
Application.DisplayAlerts = True
MsgBox "拆分工作簿完成！"
End Sub

Answer 5

全部复制，新建保存