[VBA] Sheet 를 각각의 파일명으로 분리하여 저장(기존 파일 삭제)

Sheet 를 내보내기를 할 때 기존에 내보낸 내용은 무시하고 새로운 내용을 파일로 내보내고 싶다면 기존에 생성된 파일을 삭제해야 한다.

기존 파일을 삭제하라는 명령어는

Kill 경로 & 파일명

oldName = Split(.Name, ".")(0)      '// 파일의 이름만 추출

라고 한 부분은 파일명에 마침표(.)가 들어간 경우에는 문제가 생길 수도 있다.

이럴 경우에는 oldName = Left(.Name, InStrRev(.Name, ".") - 1) 으로 변경해주면 된다.

즉, Left(파일명,길이) 함수와 InstrRev 함수(식별자 . 를 문자열 끝에서부터 계산하여 위치를 반환)를 사용하면 정확하게 확장자만 제외하고 파일명을 반환한다.

Debug.Print 구문을 사용한 이유는 삭제되는 파일이 뭔지 확인하기 위한 목적이다.

직접 실행창에 삭제되는 파일명이 표시된다.

아래와 같이 If Magbox 기능을 이용하여 파일 삭제 여부를 확인하고 처리하게 할 수도 있다.

            If Dir(newName, vbDirectory) <> Empty Then  '// 파일이 있으면
                If MsgBox(newName & "파일이 있는데 삭제하시겠습니까?", vbYesNo) = vbYes Then
                    Debug.Print newName & " 파일이 있어 삭제하고 생성합니다"
                    Kill newName    '// 기존 파일 삭제
                Else
                    MsgBox "먼저 파일을 확인하고 실행하세요"
                    Exit Sub
                End If
            End If

Option Explicit
Sub EachSheet_Into_SeperateFiles_AsSave()  '// 파일 이름 + sheet 이름으로 저장됨
'//  본 실행문은 Sheet 가 비어있는 것은 내보내기 하지 않음
    Dim wb  As Workbook
    Dim sht As Worksheet
    Dim rngUsed As Range
    Dim i%, n%
    Dim oldName, newName As String

    Application.ScreenUpdating = False
    For Each sht In Worksheets   '// 각 sheet를 순환
        If Not (sht.Cells.SpecialCells(xlCellTypeLastCell).Address(0, 0) = "A1" And sht.Cells(1, 1).Value = "") Then
            With ThisWorkbook
                oldName = Split(.Name, ".")(0)      '// 파일의 이름만 추출
                newName = .Path & "\" & oldName & "-" & sht.Name & ".xlsx" '// 현재 폴더에 새로운 파일명 지정
            End With
   
            If Dir(newName, vbDirectory) <> Empty Then  '// 파일이 있으면
                Debug.Print newName & " 파일이 있어 삭제하고 생성합니다"
                Kill newName    '// 기존 파일 삭제
            End If
            Set rngUsed = sht.Cells    '// sheet의 전 영역을 복사
            Set wb = Workbooks.Add   '// 새 엑셀파일(통합문서)를 열음. 아직 파일로 저장된 것은 아님
            If ActiveWorkbook.Sheets.Count <> 1 Then   '// 새 엑셀파일 sheet 개수 1개만 남길 목적으로 검사
                Application.DisplayAlerts = False        '// 경고창이 뜨지 않도록 설정
                    For i = ActiveWorkbook.Sheets.Count To 2 Step -1  '// 총 sheet 개수부터 시작해서 1개만 남기고 삭제
                    ActiveWorkbook.Sheets(i).Delete
                Next i
                Application.DisplayAlerts = True    '// 경고창이 뜨도록 되돌려 놓음
            End If
                  
            rngUsed.Copy wb.Sheets(1).[A1]
            wb.SaveAs Filename:=newName  '//파일명 저장
            wb.Close
            n = n + 1
        End If
    Next sht

    Application.ScreenUpdating = True

    If n = 0 Then
        MsgBox "내보내기할 시트가 없습니다"
    Else
        MsgBox n & " 개 파일 생성 완료"
    End If
End Sub

파일시트내보내기.xlsm