[가입기념] 한개의 파일에 있는 많은 씨트자동으로 내보내기...`

[로렌댜]

오늘 첫가입한 기념으로 유용한 엑셀 VBA 코드공유하려고 하는데요...

이미 알고계시는 분들도 많으리라 생각합니다. 전 단순히 복사해서 사용하는 정도의 수준이구요 ^^

저도 네이버 지식IN 에서 찾아 저만의 개인 카페에 기록하여

매우 유용하게 사용하고 있는건데요

VBA코드에 대해서는 저도 잘 모르는 지라 설명하기는 힘들어도 사용법정도는 ^^...

-------------------------------------------------------------------------------

엑셀에서 수많은 씨트를 하나씩 내보내기 하기엔 너무 힘들다.

자동으로 씨트명을 파일명으로 저장하여 내보내기 하는 VB소스

방법 :

1. ALT + F11 키눌러 비쥬얼베이직 창을 호출

2. 좌측메뉴 프로젝트창에서 현제 파일명의 "Microsoft Excel 개체"를 마우스 오른쪽 버튼으로 클릭

3. 메뉴 -> 삽입 -> 모듈 선택

4. 아래코드를 통체로 복사하여 붙여넣기

5. 코드실행 <VB창 PLAY 단축버튼 클릭>

   ->>> 모든 시트가 현제파일이 저장된 폴더에 씨트명을 파일명으로하여

            내보내기한후 자동종료 함.

★ 2007이상버젼에서 사용후 2007이전 버젼엑셀에서 실행시 열리지 않음. 주의.

---------- 아래 전체 복사 -----------

Sub dhTest()
Dim wb As Workbook
Dim wbTemp As Workbook
Dim s As Worksheet
Dim strPath As String
Dim strFile As String
Const cTag As String = ".xls"
    '작업할 통합문서입니다
    Set wb = ActiveWorkbook
   
    '경로명을 구합니다.
    strPath = wb.Path
    If Len(strPath) = 0 Then '저장되지 않은 문서의 경우라면
        '엑셀 기본 문서 저장 경로(대개 My Documents입니다)에 저장합니다
        strPath = Application.DefaultFilePath
    Else
    End If
    strPath = strPath & Application.PathSeparator
   
    For Each s In wb.Worksheets
        '현재 시트의 이름으로 파일을 저장하도록 이름을
        '변수에 담습니다.
        strFile = strPath & s.Name & cTag
        '새문서로 파일을 내 보냅니다, 즉 새로 만듭니다.
        If s.Visible = True Then
            s.Copy
            Set wb = ActiveWorkbook
            'wb.SaveAs strFile '저장하고 (기본형식)

             wb.SaveAs strFile, fileformat:=xlexcel7 '저장하고 (엑셀 97~2003 형식)
             wb.Close '닫습니다
        Else
        End If
    Next s
   
End Sub