[VBA_파일통합] 폴더속 파일 통합하기

폴더속 엑셀 파일들을 [통합]시트에 합치는 작업을 하려고 한다.

 

유의해야 할것은 각각의 파일들에서 헤더값들은 중복이 됨으로 헤더값을 제외한 DATA 영역의 값만 가져오는것이 관건이다.

 

'= 헤더값을 제외한 내용부분
Set srcRange = ActiveSheet.UsedRange.Rows("2:" & ActiveSheet.UsedRange.Rows.Count)

 

 

이렇게 하면 헤더값이 아닌 2행부터 데이터가 있는 값들을 가져올 수 있기 때문에 헤더중복을 피할 수 있다.

 

Option Explicit

Sub 파일통합()

    Dim srcRange As Range
    Dim destRange As Range
    Dim str$
    Dim n&
    Dim Strpath$, Filename$
    
    Sheets("통합").[a2:i1000].ClearContents
    With Application.FileDialog(msoFileDialogFolderPicker)       '= 파일다이얼로그를 통해 폴더를 선택해라
    
        .Title = "파일리스트를 가져올 폴더를 선택하세요"              '= 대화창의 타이틀
        .Show                                                     '= 대화창을 보여줘라
        
        If .SelectedItems.Count = 0 Then                          '= 선택하지 않으면
            Exit Sub                                              '= 종료해라
            
        Else
        
            Strpath = .SelectedItems(1) & "\"                     '= 선택하였다면 경로를 StrParh에 저장해라
            
        End If

    End With
    
    Filename = Dir(Strpath)                                        '= filename을 경로에 있는 파일들로 해라
    
    Do While Filename <> ""                                        '= filename 없을때까지 반복해라
    
      
        Workbooks.Open (Strpath & Filename)

       '= 헤더값을 제외한 내용부분
        Set srcRange = ActiveSheet.UsedRange.Rows("2:" & ActiveSheet.UsedRange.Rows.Count)
        
       '= 통합시트의 내용이 있는 다음 행
        Set destRange = ThisWorkbook.Sheets("통합").Cells(Rows.Count, "A").End(3)(2)
        
        srcRange.Copy destRange
        
        ActiveWorkbook.Close False
        
        
        Filename = Dir
        
    Loop
    
  
    MsgBox "통합을 완료하였습니다."

End Sub

 

파일통합.xlsm

0.03MB