VBA_Excel代码大全（更新2023.07.25）

Sub 拆分工作薄()
 Dim xpath As String
 xpath = ActiveWorkbook.Path
 Dim sht As Worksheet
 For Each sht In ActiveWorkbook.Sheets
 sht.Copy
 ActiveWorkbook.SaveAs Filename:=xpath & "\" & sht.Name & ".xlsx" '将文件存放在工作薄所在的位置
 ActiveWorkbook.Close
 Next
 MsgBox "拆分完毕！"
End Sub

Sub SplitSheetsToFiles()

' Declare variables
Dim ws As Worksheet
Dim i As Integer
Dim newBook As Workbook

' Loop through all worksheets in the workbook
For Each ws In ThisWorkbook.Sheets
    If Not ws.Visible = xlSheetVeryHidden Then
        Set newBook = Workbooks.Add
        ws.Copy Before:=newBook.Sheets(1)
        newBook.SaveAs ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
        newBook.Close
    End If
Next ws
MsgBox "拆分完毕！",,"逗号Office技巧"
End Sub