반응형
안녕하세요, 오늘은 한 폴더에 있는 여러 엑셀들을 하나의 엑셀로 불러와 각 시트별로 저장하는 코드를 포스팅 하려 합니다.
필요한 기술은 다음과 같습니다.
1. 폴더 내 특정 형식의 파일명 불러오기
'엑셀들이 담겨있는 폴더명 가져오기
폴더명 = ThisWorkbook.Path + "\"
'폴더 내에 ".xlsx" 형식의 첫번째 엑셀 이름 가져오기
파일명 = Dir(폴더명 & "*.xlsx")
2. Do ~ while 조건 반복문
i = 1
'조건이 만족된 상태에서만 아래 내용이 수행됨
Do While i < 100
Cells(i, 1) = i
i = i + 1
Loop
3. 엑셀 열기, 닫기, 활성화 하기
'경로 지정
전체경로 = 폴더명 & 파일명
'파일 열기
Set 엑셀파일 = Workbooks.Open(전체경로)
'활성화 시키기
Windows(전체경로).Activate
'엑셀 종료(저장하지 않음)
엑셀파일.Close SaveChanges:=False
이 세 가지 핵심 코드를 이용해서, 특정 폴더 내에 있는 여러 엑셀 파일들을
하나의 엑셀에 각 시트별로 저장하는 코드를 작업했습니다.
최종 코드는 아래와 같습니다.
Sub 엑셀_병합하기()
메인파일 = "메인엑셀.xlsm"
'엑셀들이 담겨있는 폴더명 가져오기
폴더명 = ThisWorkbook.Path + "\"
'폴더 내에 ".xlsx" 형식의 첫번째 엑셀 이름 가져오기
파일명 = Dir(폴더명 & "*.xlsx")
'Do while ~ Loop 문을 이용하여 폴더 내의 전체 "*.xlsx" 파일들을 탐색하면서
'하나의 "*.xlsx" 파일을 불러올 때마다 복사 기능과 붙여넣기 기능들을 넣고 반복문을 추가하였습니다.
Do While 파일명 <> ""
'가져온 파일명에 폴더명을 추가하여 전체 경로를 불러오게 합니다.
전체경로 = 폴더명 & 파일명
'잘 가져오고 있는지 직접 실행창에 프린트 해서 검토합니다.
Debug.Print (전체경로)
Set 엑셀파일 = Workbooks.Open(전체경로)
'전체경로 엑셀 실행
'복사할 위치의 우측 끝과 아래끝 위치를 미리 찾아둠
우측끝번호 = Range("A1").End(xlToRight).Column
아래끝번호 = Range("A1").End(xlDown).Row
'미리 찾아둔 우측 끝과 아래끝 좌표를 이용하여 복사할 범위를 지정
Set 범위 = Range(Cells(1, 1), Cells(아래끝번호, 우측끝번호))
'메인 엑셀 파일 활성화
Windows(메인파일).Activate
Sheets.Add(After:=Sheets(Sheets.Count)).Name = 파일명
'지정된 범위를 복사 후 붙여넣기 할 장소 선택 (cells(1,1)은 타이틀이 들어가야 하는데,
'타이틀은 직접 붙여넣었음
범위.Copy Destination:=Cells(1, 1)
' 엑셀파일 닫기 (저장하지 않음)
엑셀파일.Close SaveChanges:=False
'Do while 문의 끝 지점을 정하기 위해, 다음 파일명이 존재하는지 확인합니다.
파일명 = Dir
Loop
End Sub
반응형