한 폴더 안의 모든 파일에서 특정 시트 복사해오는 vba

네이버 지식인에서  큰형(ks_1862)님의 답변 중 참고하였습니다.

D:\TEMP 라는 폴더 안에 있는 모든 XLSX 확장자를 가진 엑셀파일에서 "통계"라는 이름을 가진 시트를 복사해옵니다.

Option Explicit
Sub MergeWBs()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

MyPath = "D:\temp"
Set wbDst = ThisWorkbook
strFilename = Dir(MyPath & "\*.xlsx", vbNormal)
If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets("통계")
wsSrc.Copy after:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFilename = Dir()
Loop

wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

2017.2.16 몇가지 기능을 추가한 버전입니다

1. '통계'란 시트가 없는 파일이 있으면 에러 메시지 출력

2. 복사해온 '통계' 시트 전체 내용을 값으로 붙여넣기

3. 맨처음 복사해온 '통계' 시트의 이름을 '통계 (1)'로 변경

4. '합계' 시트에 모든 '통계' 시트의 값 더하기 (sum함수)

5. '홈페이지' 시트에 모든 시트의 통계값 표시

6. '홈페이지' 시트내용 값으로 붙여넣기 후 정렬

7. 모든 시트 복사후 새로운 파일명으로 저장(XLSX형식)

다운로드