[VBA/엑셀] 폴더 내 엑셀 파일 합치기 메크로

안녕하세요, 구칠씀입니다.

오늘은 지정한 폴더 내에 있는 모든 엑셀파일을 하나로 합치는 메크로 소개해드릴게요!

 

 

폴더 안에 모든 엑셀 내용을 일일이 합치는 것도 가능하지만

파일 수가 많아질수록 시간이 너무 오래걸리는 번거로운 작업이에요.

해당 메크로를 사용하면 모든 xlsx파일에 접근하여 열고,

모든 시트를 복사하여 하나의 파일에 붙혀줘요!

 

 

아래 코드를 복사하셔도 되고, 첨부 파일을 다운 받아서 실행하셔도 됩니다.

 

 

---

 

폴더 내 엑셀파일 합치기 메크로

 

 

1. 메크로 실행
2.  사용자로부터 폴더 경로 입력 받기(이때 기본 값은 메크로를 실행하는 파일이 위치한 경로)
3. 해당 폴더 내 모든 xlsx파일을 열어 모든 시트를 복사하여 메크로 실행 파일에 붙혀넣기
4. 위의 작업이 완료되면 파일을 닫고 폴더 내 다음 파일로 이동하여 3번 작업 반복

 

<VBA 코드>

Option Explicit

Sub MergeFile_ver_xlsx()
    '메크로기능: 사용자가 입력한 폴더 내 모든 엑셀파일의 시트전체를 메크로 실행 파일에 복사,
    '작업내역 시트를 추가하여 복사한  파일 목록 출력
    
    Dim wb As Workbook: Set wb = ActiveWorkbook '현재 파일을 저장
    Dim wbForTemp As Workbook '복사할 파일을 임시 저장
    Dim strfile As String '폴더 내 xlsx파일 이름 변수
    Dim strfolder As String '폴더 경로 변수
    Dim answer As String '사용자 입력 저장 변수
    Dim fileCount As Integer: fileCount = 0 '폴더 내 파일(xlsx파일)개수 카운트 '
    
    strfolder = wb.Path
    
    answer = InputBox("취합할 엑셀 파일이 있는 폴더 경로를 입력해주세요", Title:="Merge xlsx files in selected folder", Default:=strfolder)
    
    If Right(answer, 1) <> "\" Then
        strfolder = answer & "\"
    Else
        strfolder = answer
    End If
    
    strfile = Dir(strfolder & "*.xlsx")
    
    '폴더에 엑셀파일이 하나도 없는 경우, 안내문을 출력하고 프로시저 종료
    If strfile = "" Then
        MsgBox "해당 폴더에는 xlsx파일이 없습니다"
        Exit Sub
    '폴더에 xlsx파일이 하나 이상인 경우, "MergeFile_ver_xlsx_작업내역" 시트 추가하여 경로, 파일갯수, 파일목록 작성
    Else
        Worksheets.Add before:=Sheets(1)
        With ActiveSheet
            .Name = "MergeFile_ver_xslx_작업내역"
            With .Range("b2")
                .Value = "폴더경로"
                .Interior.Color = vbGreen
                .Font.Bold = True
            End With
            .Range("b3") = strfolder
             With .Range("c2")
                .Value = "xlsx파일갯수"
                .Interior.Color = vbGreen
                .Font.Bold = True
            End With
            .Range("b5") = "번호"
            .Range("c5") = "파일명"
        End With
    End If
    
    
    Do While strfile <> ""
        '파일 갯수 +1
        fileCount = fileCount + 1
        '작업내역 작성하기
        With wb.Sheets("MergeFile_ver_xslx_작업내역")
            .Range("B" & 5 + fileCount) = fileCount
            .Range("C" & 5 + fileCount) = strfile
        End With
        
        Application.Workbooks.Open Filename:=strfolder & strfile
        
        Set wbForTemp = ActiveWorkbook
        wbForTemp.Sheets.Copy after:=wb.Sheets(1)
        wbForTemp.Close
        
        strfile = Dir()
    Loop
    
    
    Sheets("MergeFile_ver_xslx_작업내역").Range("c3") = fileCount
    Range("b2").CurrentRegion.Select
    Selection.EntireColumn.AutoFit
    
End Sub

Mod_MergeFile_ver_xlsx.bas

0.00MB