엑셀 시트 한개씩 단일파일로 저장하기

Sub 시트저장()
    Dim Sht As Worksheet
    Dim strPath As String
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Path & "\"
    For Each Sht In Worksheets
    With Sht
    .Copy
    ChDir strPath
    ActiveWorkbook.SaveAs Filename:=strPath & Sht.Name & ".xlsx"
    ActiveWindow.Close
    End With
    Next Sht
End Sub