엑셀-여러시트 데이터 모으기(VBA,매크로)

■ 엑셀 데이터 모으기

- 여러 시트의 특정 영역의 데이터를 한 시트에 모아주는 VBA 코드입니다.

- 해당 VBA 코드는 글 제일 마지막에 있습니다

조건1 : 각각의 데이터 시트안에 데이터의 위치는 동일해야 원하는 데이터를 취합할 수 있습니다.

조건2 : 이 VBA 코드는 세로(열)범위의 데이터를 지정하고 취합합니다.

-예시)

Sheet1, Sheet2, Sheet3, 각각 동일한 위치에 데이터를 배치합니다

취합할 데이터의 범위는  A1:A10까지 지졍하겠습니다

해당 코드를 실행하게되면

CombinedData 시트가 생성되며 1행에 각 시트의 이름이 기록되고, 그 아래로 해당 시트의 데이터가 나열됩니다.

CombinedData 시트의 마지막 열은 지워주시면 됩니다.

-주의 사항

해당 범위를 2열 이상 지정하더라도 첫번재 열의 데이터만 취합됩니다.

 

-VBA 코드

    Sub 여러시트_데이터_모으기()
    Dim combinedWs As Worksheet
    Dim sourceWs As Worksheet
    Dim destWs As Worksheet
    Dim destRow As Long
    Dim destCol As Long
    Dim cell As Range
    Dim selectedRange As Range
    Dim sheetNameCell As Range
    
    ' 새 시트 생성
    On Error Resume Next
    Set combinedWs = ThisWorkbook.Sheets("CombinedData")
    On Error GoTo 0
    
    If combinedWs Is Nothing Then
        Set combinedWs = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        combinedWs.Name = "CombinedData"
    Else
        MsgBox "시트 'CombinedData'가 이미 존재합니다."
        Exit Sub
    End If
    
    ' 목표 시트 선택
    Set destWs = combinedWs
    destRow = 1 ' 시작 행 (시트 이름 행)
    destCol = 1 ' 시작 열 (시트 이름 열)
    
    ' 모든 시트의 이름을 가로로 모으기
    For Each sourceWs In ThisWorkbook.Worksheets
        destWs.Cells(destRow, destCol).Value = sourceWs.Name
        destCol = destCol + 1
    Next sourceWs
    
    ' 각 시트의 데이터를 모으기
    For Each sourceWs In ThisWorkbook.Worksheets
        On Error Resume Next
        Set selectedRange = sourceWs.Range("A1:A10") ' 예시 범위
        On Error GoTo 0
        
        If Not selectedRange Is Nothing Then
            destRow = 2 ' 시작 행 (데이터 시작 행)
            destCol = sourceWs.Index ' 해당 시트의 인덱스를 시작 열로 사용
            
            ' 해당 시트의 데이터 추가
            For Each cell In selectedRange
                destWs.Cells(destRow, destCol).Value = cell.Value
                destRow = destRow + 1
            Next cell
        End If
    Next sourceWs

    ' 복사한 데이터를 서식과 함께 붙여넣기
    destWs.UsedRange.Copy
    destWs.Range("A1").PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False ' 복사 모드 해제
' 안내 메시지 표시
    MsgBox "데이터 모으기 완료."
End Sub

예시 범위를 원하는 범위로 지정하면 자유롭게 사용가능합니다