将Excel文件中的工作表，全部另存为新的工作簿。For i = 2 To Sheets.Count代表第一个sheet不拆分，可以改成1，则全拆分；.SaveAs Filename:=ThisWorkbook.Path & "\" & ShtNm & ".xlsx"代表存的位置
Private Sub CommandButton2_Click()
Dim tip
tip = MsgBox("将会把所有拆分好的工作表，另存为新的工作簿，请确认已执行过拆分工作表，并且文件所在文件夹没有教师同名文件", vbOKCancel)
If tip <> 1 Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim i As Integer
Dim ShtNm As String
For i = 2 To Sheets.Count
ShtNm = Sheets(i).Name
Sheets(i).Copy
With ActiveWorkbook
.SaveAs Filename:=ThisWorkbook.Path & "\" & ShtNm & ".xlsx"
.Close
End With
Next
Application.ScreenUpdating = True
MsgBox ("批量生成工作薄完成。")
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
原创文章，作者：熊阿初，如若转载，请注明出处：https://www.guofc.com/360.html
![[Excel VBA]指定行数将所有工作表合并](https://www.guofc.com/wp-content/themes/justnews/themer/assets/images/lazy.png)