취합

Sub ConsolidateData()
    Dim folderPath As String
    Dim fileName As String
    Dim newWB As Workbook
    Dim ws As Worksheet
    Dim conn As Object
    Dim rs As Object
    Dim lastRow As Long

    ' 폴더 경로 설정
    folderPath = "C:\Your\Folder\Path\"

    ' 새 워크북 생성
    Set newWB = Workbooks.Add
    Set ws = newWB.Sheets(1)
    ws.Cells(1, 1).Value = "파일명"
    ws.Cells(1, 2).Value = "데이터"

    ' ADO 연결 객체 생성
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    ' 폴더 내 모든 엑셀 파일 순회
    fileName = Dir(folderPath & "*.xls*")
    Do While fileName <> ""
        ' ADO 연결 문자열 설정
        conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & folderPath & fileName & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
        
        ' Recordset 열기
        rs.Open "SELECT * FROM [요구$]", conn, 1, 3
        
        ' 데이터 복사
        Do While Not rs.EOF
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
            ws.Cells(lastRow, 1).Value = fileName
            For i = 0 To rs.Fields.Count - 1
                ws.Cells(lastRow, i + 2).Value = rs.Fields(i).Value
            Next i
            rs.MoveNext
        Loop
        
        ' Recordset 및 연결 닫기
        rs.Close
        conn.Close
        fileName = Dir
    Loop

    ' 객체 해제
    Set rs = Nothing
    Set conn = Nothing
    Set ws = Nothing
    Set newWB = Nothing
End Sub