추출

Sub ExtractDataFromFiles()
    Dim FolderPath As String
    Dim FileName As String
    Dim SpecificText As String
    Dim cn As Object
    Dim rs As Object
    Dim ws As Worksheet
    Dim NewBook As Workbook
    Dim NewSheet As Worksheet
    Dim Row As Long
    Dim Col As Long

    FolderPath = "C:\Your\Folder\Path\" ' 폴더 경로를 지정하세요.
    SpecificText = "특정글자" ' 특정 글자를 지정하세요.

    Set NewBook = Workbooks.Add
    Set NewSheet = NewBook.Sheets(1)
    Row = 1
    Col = 1

    FileName = Dir(FolderPath & "*.xlsx")
    Do While FileName <> ""
        If InStr(FileName, SpecificText) > 0 Then
            Set cn = CreateObject("ADODB.Connection")
            cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FolderPath & FileName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"

            Set rs = CreateObject("ADODB.Recordset")
            rs.Open "SELECT * FROM [요구$A3:Z10000]", cn, 1, 3

            Do While Not rs.EOF
                For Col = 0 To rs.Fields.Count - 1
                    NewSheet.Cells(Row, Col + 2).Value = rs.Fields(Col).Value
                Next Col
                NewSheet.Cells(Row, 1).Value = Mid(FileName, InStr(FileName, SpecificText) + Len(SpecificText))
                rs.MoveNext
                Row = Row + 1
            Loop

            rs.Close
            cn.Close
            Set rs = Nothing
            Set cn = Nothing
        End If
        FileName = Dir
    Loop
End Sub