엑셀 VBA 파일 합치기 모듈 :: 엑셀 파일병합 프로그램

Public Function Multiple_FileDialog(Optional Title As String = "파일을 선택하세요", Optional FilterName As String = "엑셀파일", _
Optional FilterExt As String = "*.xls; *.xlsx; *.xlsm", Optional InitialFolder As String = "", _
Optional InitialView As MsoFileDialogView = msoFileDialogViewList, Optional MultiSelection As Boolean = True) As String
 
Dim FDG As FileDialog
Dim Selected As Integer: Dim i As Integer
Dim ReturnStr As String
 
Set FDG = Application.FileDialog(msoFileDialogFilePicker)
 
With FDG
.Title = Title
.Filters.Add FilterName, FilterExt
.InitialView = InitialView
.InitialFileName = InitialFolder
.AllowMultiSelect = MultiSelection
Selected = .Show
 
If Selected = -1 Then
For i = 1 To FDG.SelectedItems.Count - 1
ReturnStr = ReturnStr & FDG.SelectedItems(i) & ", "
Next i
ReturnStr = ReturnStr & FDG.SelectedItems(.SelectedItems.Count)
 
Multiple_FileDialog = ReturnStr
ElseIf Selected = 0 Then
MsgBox "선택된 파일이 없으므로 프로그램을 종료합니다."
End
End If
 
End With
 
End Function

Private Sub btnSelect_Click()
 
Dim strFilePath As String
Dim varFilePaths As Variant: Dim varFilePath As Variant
 
' 파일 선택 창 명령문에서 선택된 파일경로를 strFilePath로 받아옵니다.
strFilePath = Multiple_FileDialog
 
varFilePaths = Split(strFilePath, ", ")
 
Me.lstWB.Clear
' 각 파일 경로를 리스트상자에 추가합니다.
For Each varFilePath In varFilePaths
    Me.lstWB.AddItem varFilePath
Next
 
End Sub

Dim WB as Workbook 	' : 병합할 엑셀파일입니다.
Dim WS as Worksheet 	' : 병합할 엑셀파일에 작성된 각각의 워크 시트입니다.
Dim toWS as Worksheet 	' : 각 WS의 내용을 취합할 활성화된 워크 시트입니다.
Dim rng as Range 		' : 각 WS에서 취합될 범위입니다.
Dim i as Long 		' : 리스트상자에 선택된 엑셀파일들의 순번입니다.
Dim j as Long 		' : 복사한 rng를 toWS에 붙여넣기 할 행 번호입니다.
Dim endCol as Long 	' : rng의 넓이를 계산하기 위한 마지막 열번호입니다.
Dim endRow as Long 	' : rng의 넓이를 계산하기 위한 마지막 행번호입니다.
Dim strWS as String 	' : 이전 시트합치기 명령문에서만 사용된 변수이므로 지워도 무방합니다.

'// 오류방지
If Me.lstWB.ListCount = 0 Then
    MsgBox "병합할 파일을 선택하세요."
    Exit Sub
End If

For i = 0 To Me.lstWB.ListCount - 1
    Set WB = Application.Workbooks.Open(Me.lstWB.List(i))
 
	‘// 각 엑셀파일에서 실행될 명령문 작성 
 
WB.Close
Next

For Each WS In WB.Worksheets
        If WS.Name Like Me.txtFilter.Value & "*" Then
 
		‘// 해당 워크시트에서 실행될 명령문 작성
 
	  End If
Next

With WS
    endCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    endRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set rng = .Range(.Cells(2, 1), .Cells(endRow, endCol))
    rng.Copy toWS.Cells(j, 1)
    j = j + rng.Rows.Count
End With

'// 안내메세지
MsgBox "파일 병합이 완료 되었습니다."
Unload Me

'// 스크린업데이트 및 파일 저장 알림 중단
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
'// ..................
'// 실행할 명령문 작성
'// ..................
 
'//스크린 업데이트 파일 저장 알림 활성화
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Private Sub btnMerge_Click()
 
Dim WB As Workbook
Dim WS As Worksheet: Dim toWS As Worksheet
Dim rng As Range
Dim i As Long: i = 0: Dim j As Long
Dim endCol As Long: Dim endRow As Long
Dim strWS As String
 
'// 스크린업데이트 및 파일 저장 알림 중단
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
'// 오류방지
If Me.lstWB.ListCount = 0 Then
    MsgBox "병합할 파일을 선택하세요."
    Exit Sub
End If
 
'// 파일병합
Set toWS = ActiveSheet
j = toWS.Cells(toWS.Rows.Count, 1).End(xlUp).Row
 
For i = 0 To Me.lstWB.ListCount - 1
    Set WB = Application.Workbooks.Open(Me.lstWB.List(i))
    For Each WS In WB.Worksheets
        If WS.Name Like Me.txtFilter.Value & "*" Then
                With WS
                    endCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                    endRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                    Set rng = .Range(.Cells(2, 1), .Cells(endRow, endCol))
                    rng.Copy toWS.Cells(j, 1)
                    j = j + rng.Rows.Count
                End With
        End If
    Next
    WB.Close
Next
 
'// 안내메세지
MsgBox "파일 병합이 완료 되었습니다."
Unload Me
 
'// 스크린업데이트 및 파일 저장 알림 활성화
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub

Sub Merge_Workbook()
 
frmWBSelect.Show
 
End Sub