(소스제공)엑셀 파일과 시트를 하나의 시트로 통합하는 아주 쉬운 방법 [Excel macro: file & sheet combine - one sheet, source offer]

매크로 소스는 댓글에 넣어 두었습니다
#정보시스템 감리
#사무자동화
#IT
#excel
#macro
#매크로
#엑셀

[@tv-bq7sr]

아래의 소스 내용을 엑셀의 매크로 작성 화면에 붙여넣기 하시면 됩니다.

Sub 엑셀파일_한시트로합하기()

Dim filenames As Variant
Dim file As Variant
Dim wrkBook As Workbook
Dim targetSheet As Worksheet
Dim targetCell As Range
Dim i, copyRowsCount, targetRow As Long

Application.ScreenUpdating = False '


filenames = Application.GetOpenFilename(Title:="복사대상엑셀파일선택", MultiSelect:=True) '복사대상파일을 filenames 변수에 저장
Set targetSheet = Worksheets.Add '시트를 추가하여 targetSheet 변수에 저장 (이 시트에 복사한 파일의 시트를 연속하여 붙여넣음)
targetSheet.Move After:=Sheets(Sheets.Count) 'targetSheet를 시트 맨 마지막으로 이동 (불필요)

targetSheet.Range("A1") = "파일명" '첫행에 원하는 레일블 씀
targetSheet.Range("B1") = "시트명" '첫행에 원하는 레이블 씀
targetRow = 2 'targetRow 는 복사 위치 행번호를 저장하는 변수. 처음에는 2행으로 세팅

For Each file In filenames 'filenames 에 저장된 file수만큼 반복
Set wrkBook = Workbooks.Open(file) '파일을 wrkBook변수에 저장

For i = 1 To Sheets.Count '해당파일의 시트수 만큼 반복
wrkBook.Sheets(i).Select '복사할 시트를 선택
Set targetCell = targetSheet.Cells(targetRow, 3) '레인지 변수에 붙여넣을 위치값 저장(행은 계속변하고 열은 3열 고정)
wrkBook.Worksheets(i).UsedRange.Copy targetCell '복사 시트의 데이터 사용 범위를 targetCell에 셀포인트 두고 복사

targetSheet.Cells(targetRow, 1) = ActiveWorkbook.Name '선택 파일 이름을 1열에 붙여넣음
targetSheet.Cells(targetRow, 2) = ActiveSheet.Name '선택 시트의 이름을 2열에 붙여넣음

targetRowBf = targetRow
targetRow = targetRow + wrkBook.Worksheets(i).UsedRange.Rows.Count '새로 붙여넣을 위치를 targetRow에 저장 (사용범위의 행수 더함)
targetSheet.Range(Cells(targetRowBf, 1).Address, Cells(targetRow, 2).Address).FillDown '파일 이름과 시트 이름을 복사한 시트의 row갯수 만큼 채움
Next i

wrkBook.Close savechanges:=False '파일 닫기

Next file

End Sub