将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