Sub ExportSheets()
" 현재 파일의 시트를 모두 새로운 엑셀 파일로 내보내기 합니다.
Dim wkb As Workbook
Dim sht As Worksheet
Dim i As Integer
Application.ScreenUpdating = False
" 화면 갱신을 중단합니다.
Application.DisplayAlerts = False
" 메시지 호출을 중단합니다.
For Each sht In ThisWorkbook.Worksheets
" 현재 파일의 시트를 모두 내보냅니다.
Set wkb = Workbooks.Add(xlWBATWorksheet)
" 새로운 워크북을 생성합니다. (시트는 1개)
With wkb
sht.Copy .Sheets(1)
" 시트를 복사합니다.
.Sheets("sheet1").Delete
" 새로 생성된 워크북의 시트를 삭제합니다.
.Close SaveChanges:=True, Filename:=ThisWorkbook.Path & _
"\xlSheets_" & sht.Name & ".xls"
" 파일을 닫으면서 저장합니다. 파일명은 xlSheets_시트명.xls로
" 이 파일이 저장된 위치에 만들어집니다.
i = i + 1
End With
Next
MsgBox "총 " & i & " 개의 파일이 새로 생성되었습니다." & Chr(13) & Chr(13) & _
"저장위치는 "" & ThisWorkbook.Path & "" 입니다.", vbInformation, "시트 내보내기"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
최신 콘텐츠