Sub 分割表() Application.ScreenUpdating = False For i = 3 To Sheets.Count a = Sheets(i).Name Sheets(i).Select Sheets(i).Copy ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "" & a & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWorkbook.Close Next Application.ScreenUpdating = True End Sub