한 폴더 안의 모든 파일에서 특정 시트 복사해오는 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형식)

!!!!0210)만족도설문통계합치기-완성본.xlsm