[엑셀VBA] 시트별로 따로 파일 저장하기

엑셀 시트별로 따로 파일 저장하기

엑셀의 시트를 따로 파일로 저장해야 하는 일은 뭐가 있을까? 청구서를 한개의 파일로 관리하다가, 업체별로 뿌린다거나, 각 팀별로 자료를 전달할때? 아직까지는 원하는 만큼 파일을 복사해두고, 파일을 하나하나씩 까서, 시트를 지웠던 것으로 기억한다. 하나씩 파일을 열고 시트를 지우다보면 내가 뭘 지웠는지, 어디까지 지웠는지, 뭘 남겼는지 혼란스러울 때도 있긴하다.

 

전제사항

당연한 이야기지만, 다른 시트에서 데이터를 참조하고 있다면, 시트를 분리하는 순간, 엉망징창이 될 것이니, 이때는 쓰지 않도록 한다.(원본 파일을 참조하게 된다.)

원본파일의 시트 이름이 Sheet1 처럼 기본적으로 주어지는 이름이라서, 새로 생성되는 파일과 이름이 같게 된다면, Sheet1(2)처럼 엑셀이 알아서 바꿔준다.(신박하게도..)

 

과정

프로그램으로 파일을 생성하거나 복사하다보면 매번 부딪히는 문제는 중복의 문제이다. 이를 피하기 위해 아래와 같이 프로세스를 짰다.

 

#1 실행하는 이 순간의 연/월/일/시간/분/초 데이터를 구한다.

#2 대상폴더를 정한다.

#3 연/월/일/시간/분/초 데이터로 폴더를 만든다

#4 연/월/일/시간/분/초 데이터로 된 폴더안에 연/월/일/시간/분/초 데이터 + 시트이름으로 된 파일을 생성한다.

#5 생성된 파일에 해당 시트를 복사하고, 저장 후 닫아준다.

 

엑셀이 아닌 윈도우 리소스를 사용하는 코드를 머리를 써서 적으려고 하면, 복잡한 일이 많아지므로, 대상 폴더를 정하는 함수는 인터넷 검색을 통해 오빠두 엑셀에서 통으로 찾았다. 이분들은 참으로 대단하다 ㅎㅎ 어려운 코딩을 해서가 아니라, 그걸 공유한다는 점에서 대단하다는 것이다. 코리안 개발자들은 공유하는 것을 꺼려하지 않는가?

 

Sub savebysheetname()

myDateTime = Now()

myDateYear = Right(Format(Year(myDateTime), "@"), 2)

myDateMonth = Month(myDateTime)

myDateDay = Day(myDateTime)

myDateHour = Hour(myDateTime)

myDateMinute = Minute(myDateTime)

myDateSecond = Second(myDateTime)

myDateTimeText = myDateYear & "_" & myDateMonth & "_" & myDateDay & "_" & myDateHour & "_" & myDateMinute & "_" & myDateSecond

'원하는 폴더

myRootFolder = FolderDialog()

If Dir(myRootFolder & "\" & myDateTimeText, vbDirectory) = "" Then

       MkDir (myRootFolder & "\" & myDateTimeText)

   Else

       MsgBox "이미 해당 경로에 폴더가 있습니다."

End If

Dim twb As Workbook

Set twb = ActiveWorkbook

shCount = twb.Worksheets.Count

twb.Save

Dim wb As Workbook

Application.ScreenUpdating = False

For i = 1 To shCount

 

    myfilename = myRootFolder & "\" & myDateTimeText & "\" & myDateTimeText & "_" & twb.Worksheets(i).Name & ".xlsx"

    Set wb = Application.Workbooks.Add

       

    twb.Worksheets(i).Copy before:=wb.Worksheets(1)

    wb.SaveAs (myfilename)

    wb.Close

Next i

Application.ScreenUpdating = True

End Sub

Function FolderDialog(Optional Title As String = "폴더를 선택하세요", Optional InitialFolder As String = "", _

Optional InitialView As MsoFileDialogView = msoFileDialogViewList)

 

Dim sFolder As String

Dim Selected As Long

 

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = Title

.InitialView = InitialView

.InitialFileName = InitialFolder

Selected = .Show

 

    If Selected = -1 Then

        sFolder = .SelectedItems(1)

        FolderDialog = sFolder

    Else

        MsgBox "선택된 폴더가 없어 프로그램을 종료합니다."

        End

    End If

End With

 

End Function