본문 바로가기
꿀팁/엑셀 꿀팁

엑셀-여러 파일 데이터 모으기(VBA,메크로)

by 꿀팁전달자 2024. 5. 26.
반응형

■ 여러 파일 데이터 모으기

- 여러 파일(엑셀,CSV 파일)의 데이터를 한 시트에 모아주는 VBA 코드입니다.

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

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

조건2 : 데이터 파일의 위치는 모두 동일해야합니다.

* VBA 코드 안에 빨간색으로 표시된 부분은 원하는 정보를 입력세요

Sub CollectDataFromMultipleFilesAndCSV()
    Dim FolderPath As String
    Dim Filename As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim destSheet As Worksheet
    Dim destRange As Range
    Dim copyRange As Range
    Dim LastRow As Long
    Dim StartCell As Range
    Dim csvWb As Workbook
    Dim i As Long
    Dim j As Long
    
    ' 폴더 경로 설정
    FolderPath = "C:\Your\Folder\Path\" ' 이 부분을 실제 폴더 경로로 변경하세요
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    
    ' 데이터를 모을 시트 설정 (예: "Summary" 시트)
    Set destSheet = ThisWorkbook.Sheets("Summary") ' 적절한 시트 이름으로 변경하세요
    Set StartCell = destSheet.Range("A1") ' 데이터를 시작할 셀
    Set destRange = StartCell
    
    ' 헤더 추가
    destRange.Value = "Filename"
    destRange.Offset(0, 1).Value = "Data"
    
    ' 엑셀 파일 처리
    Filename = Dir(FolderPath & "*.xls*")
    Do While Filename <> ""
        Set wb = Workbooks.Open(FolderPath & Filename)
        Set ws = wb.Sheets(1) ' 데이터를 가져올 시트 (필요에 따라 변경)
        
        ' 복사할 범위 설정 (예: A1:B10)
        Set copyRange = ws.Range("A1:B10") ' 적절한 범위로 변경
        
        ' 붙여넣기 위치 찾기
        LastRow = destSheet.Cells(destSheet.Rows.Count, StartCell.Column).End(xlUp).Row + 1
        Set destRange = destSheet.Range("A" & LastRow)
        
        ' 파일명 추가 및 데이터 복사
        destRange.Value = Filename
        For i = 1 To copyRange.Rows.Count
            For j = 1 To copyRange.Columns.Count
                destRange.Offset(0, (i - 1) * copyRange.Columns.Count + j).Value = copyRange.Cells(i, j).Value
            Next j
        Next i
        
        ' 원본 파일 닫기 (저장하지 않음)
        wb.Close False
        
        ' 다음 파일로 이동
        Filename = Dir
    Loop
    
    ' CSV 파일 처리
    Filename = Dir(FolderPath & "*.csv")
    Do While Filename <> ""
        Set csvWb = Workbooks.Open(FolderPath & Filename)
        Set ws = csvWb.Sheets(1) ' CSV 파일에는 일반적으로 하나의 시트만 있음
        
        ' 복사할 범위 설정 (예: A1:B10)
        Set copyRange = ws.Range("A1:B10") ' 적절한 범위로 변경
        
        ' 붙여넣기 위치 찾기
        LastRow = destSheet.Cells(destSheet.Rows.Count, StartCell.Column).End(xlUp).Row + 1
        Set destRange = destSheet.Range("A" & LastRow)
        
        ' 파일명 추가 및 데이터 복사
        destRange.Value = Filename
        For i = 1 To copyRange.Rows.Count
            For j = 1 To copyRange.Columns.Count
                destRange.Offset(0, (i - 1) * copyRange.Columns.Count + j).Value = copyRange.Cells(i, j).Value
            Next j
        Next i
        
        ' CSV 파일 닫기 (저장하지 않음)
        csvWb.Close False
        
        ' 다음 파일로 이동
        Filename = Dir
    Loop
    
    MsgBox "데이터 수집 완료!"
End Sub

반응형

'꿀팁 > 엑셀 꿀팁' 카테고리의 다른 글

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