엑셀 시트 나누기 매크로 :: Save_EachWS 명령문 사용법

Sub Save_EachWS(Optional SavePath As String, Optional SheetName As String, Optional isOverWrite As Boolean = False, Optional ExcludeSheets As String)
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ Save_EachWS 함수
'▶ 각 시트를 각각의 통합문서로 나누어 저장합니다.
'▶ 인수 설명
'_____________SavePath      : 시트를 나누어 통합문서로 저장할 폴더경로입니다. 기본값은 실행중인 통합문서와 동일한 경로입니다.
'_____________isOverWrite   : 덮어쓰기 여부입니다. 기본값은 False 입니다.
'_____________ExcludeSheets : 시트 나누기에서 제외할 시트입니다. 쉼표로 나누어 여러개 시트를 지정할 수 있습니다.
'▶ 보조 명령문 안내 : FileExist, FileSequence 함수
'###############################################################
 
Dim WS As Worksheet
Dim FPath As String
Dim vSheets As Variant: Dim vSheet As Variant
 
If SavePath = "" Then SavePath = Application.ActiveWorkbook.Path
If ExcludeSheets <> "" Then vSheets = Split(ExcludeSheets, ",")
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
For Each WS In ThisWorkbook.Sheets
    If ExcludeSheets <> "" Then
        For Each vSheet In vSheets
            If WS.Name = Trim(vSheet) Then
                GoTo Pass:
            End If
        Next
    End If
 
    WS.Copy
    FPath = SavePath & "\" & WS.Name & ".xlsx"
    If FileExists(FPath) And isOverWrite = False Then
        FPath = FileSequence(FPath)
    End If
    Application.ActiveWorkbook.SaveAs Filename:=FPath
    If SheetName <> "" Then Application.ActiveWorkbook.Worksheets(1).Name = SheetName
    Application.ActiveWorkbook.Close True
Pass:
Next
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub
 
Public Function FileExists(ByVal path_ As String) As Boolean
 
'########################################################
'입력한 파일경로에 파일 존재여부를 확인합니다.
'https://www.oppadu.com/vba-fileexists-함수/
'########################################################
 
    FileExists = (Dir(path_, vbDirectory) <> "")
 
End Function
 
 
Private Function FileSequence(FilePath As String, Optional Sequence As Long = 1, Optional Delimiter As String = "-") As String
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ FileSequence 함수
'▶ 기존 파일이 존재할 경우 순번을 매겨 파일을 저장합니다.
'▶ 인수 설명
'_____________FilePath  : 확장자를 포함한 파일 경로입니다.
'_____________Sequence  : 순번을 매길 시작번호입니다.
'_____________Delimiter : 파일명과 순번을 구분할 구분자입니다.
'▶ 보조 명령문 안내 : FileExist 함수
'###############################################################
 
Dim Ext As String: Dim Path As String: Dim newPath As String
Dim Pnt As Long
 
Pnt = InStrRev(FilePath, ".")
Path = Left(FilePath, Pnt - 1)
Ext = Right(FilePath, Len(FilePath) - Pnt + 1)
 
newPath = Path & Delimiter & Sequence & Ext
 
Do Until FileExists(newPath) = False
    Sequence = Sequence + 1
    newPath = Path & Delimiter & Sequence & Ext
Loop
 
FileSequence = newPath
 
End Function