엑셀 파일들의 시트들을 하나의 파일에 통합하기

관련: 지식인

 

VBA를 이용하면 이런 작업은 자동화시킬 수 있습니다.

요즘에는 AI에게 부탁하면 코드를 어느 정도 만들어줍니다.

대신 잘 되는지 검증이 꼭 필요합니다.

​

아래는 ChatGPT의 코드를 튜닝하였습니다.

 

Sub 여러_엑셀파일_시트_모으기()

    Dim fd As FileDialog
    Dim selectedFile As Variant
    Dim wbSource As Workbook
    Dim wbTarget As Workbook
    Dim ws As Worksheet, wsA As Worksheet
    Dim newWs As Worksheet
    Dim i As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    On Error GoTo ErrorHandler
    
    '현재 실행 중인 파일
    Set wbTarget = ThisWorkbook
    Set wsA = ActiveSheet
    
    '파일 선택 창
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
        .Title = "시트를 가져올 Excel 파일을 선택하세요"
        .AllowMultiSelect = True
        .InitialFileName = wbTarget.Path & Application.PathSeparator
        
        .Filters.Clear
        .Filters.Add "Excel 파일", "*.xlsx;*.xlsm;*.xls;*.xlsb"
        
        If .Show <> -1 Then
            GoTo ExitHandler
        End If
    End With
    
    '선택한 파일을 차례대로 처리
    For Each selectedFile In fd.SelectedItems
        
        '현재 파일 자신은 제외
        If CStr(selectedFile) <> wbTarget.FullName Then
            
            Set wbSource = Workbooks.Open( _
                Filename:=CStr(selectedFile), _
                ReadOnly:=True)
            
            '원본 파일의 모든 시트를 현재 파일로 복사
            For Each ws In wbSource.Worksheets
                
                ws.Copy After:=wbTarget.Sheets(wbTarget.Sheets.Count)
                
                Set newWs = wbTarget.Sheets(wbTarget.Sheets.Count)
                
            Next ws
            
            '원본 파일 닫기
            wbSource.Close SaveChanges:=False
            Set wbSource = Nothing
            
        End If
        
    Next selectedFile
    
    
    '=================================================
    ' 복사된 모든 시트 선택
    ' 현재 시트(wsA) 이후의 모든 시트
    '=================================================
    
    If wsA.Index < wbTarget.Sheets.Count Then
        
        wbTarget.Sheets(wsA.Index + 1).Select
        
        For i = wsA.Index + 2 To wbTarget.Sheets.Count
            wbTarget.Sheets(i).Select Replace:=False
        Next i
        
    End If
    
    
    '원래 작업하던 시트로 다시 돌아가고 싶다면
    '아래 줄은 사용하지 않습니다.
    'wsA.Activate
    
    
    MsgBox "선택한 Excel 파일의 모든 시트를 가져왔습니다. 저장하세요" & vbCrLf & vbCrLf & _
           "복사된 모든 시트를 선택한 상태입니다.", _
           vbInformation, "완료"

ExitHandler:

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    
    Set fd = Nothing
    Set wbSource = Nothing
    Set wbTarget = Nothing
    
    Exit Sub

ErrorHandler:

    MsgBox "오류가 발생했습니다." & vbCrLf & vbCrLf & _
           "오류번호: " & Err.Number & vbCrLf & _
           "내용: " & Err.Description, _
           vbExclamation, "오류"
    
    If Not wbSource Is Nothing Then
        wbSource.Close SaveChanges:=False
    End If
    
    Resume ExitHandler

End Sub

 

 

추가 코드

 

Sub 현재시트_이후_모든시트_선택()

    Dim ws As Worksheet
    Dim i As Long
    
    Set ws = ActiveSheet
    
    '현재 시트 이후의 시트가 있는 경우
    If ws.Index < ThisWorkbook.Worksheets.Count Then
        
        For i = ws.Index + 1 To ThisWorkbook.Worksheets.Count
            
            If i = ws.Index + 1 Then
                ThisWorkbook.Worksheets(i).Select
            Else
                ThisWorkbook.Worksheets(i).Select Replace:=False
            End If
            
        Next i
        
    End If

End Sub

Sub 선택된_모든시트_삭제()

    Dim answer As VbMsgBoxResult
    Dim i As Long
    
    answer = MsgBox( _
        "선택된 모든 시트를 삭제할까요?", _
        vbYesNo + vbQuestion, _
        "시트 삭제 확인")
    
    If answer <> vbYes Then Exit Sub
    
    Application.DisplayAlerts = False
    
    '선택된 시트들을 뒤에서부터 삭제
    For i = ActiveWindow.SelectedSheets.Count To 1 Step -1
        ActiveWindow.SelectedSheets(i).Delete
    Next i
    
    Application.DisplayAlerts = True

End Sub

Sub 현재시트_이후_시트삭제()

    Dim ws As Worksheet
    Dim i As Long
    Dim answer As VbMsgBoxResult
    
    answer = MsgBox( _
        "현재 시트 이후의 모든 시트를 삭제할까요?", _
        vbYesNo + vbQuestion, _
        "시트 삭제 확인")
    
    If answer <> vbYes Then Exit Sub
    
    Application.DisplayAlerts = False
    
    '현재 시트
    Set ws = ActiveSheet
    
    '현재 시트 이후의 시트를 뒤에서부터 삭제
    For i = ThisWorkbook.Worksheets.Count To ws.Index + 1 Step -1
        ThisWorkbook.Worksheets(i).Delete
    Next i
    
    Application.DisplayAlerts = True
    
    MsgBox "현재 시트 이후의 모든 시트를 삭제했습니다.", _
           vbInformation, "완료"

End Sub

 

첨부파일 파일 속성에서 차단해제하고 파일 열 때 매크로 허용해서 열고 녹색 도형을 누르면

파일 선택 대화상자가 뜨고 선택한 파일들의 모든 시트를 현재 시트 뒤에 복사합니다.

 

 

 

 

선택된 복사 시트들을 다른 데 복사하거나 삭제할 수 있게

작업 후 복사된 시트들을 모두 선택한 채 유지합니다.

 

파란 도형을 누르면 현재 시트 이후의 모든 시트를 선택합니다.

 

붉은 도형을 누르면 확인 후  현재 시트 이후의 모든 시트를 삭제합니다.

 

 

엑셀문서통합1.xlsm

0.03MB