vba 파일 취합

엑셀 VBA에서 ADO를 사용하여 파일을 직접 열지 않고 작업을 수행하는 것은 복잡할 수 있습니다. 하지만 가능한 한 간단하게 작성해 보겠습니다. 전체 코드는 길어질 수 있으므로, 각 단계를 최대한 간략하게 설명하고 제공하겠습니다.

1. 파일 복사

```vba
Sub CopyFiles()
    Dim fso As Object
    Dim srcFolder As String, destFolder As String
    Dim file As Object, folder As Object
    
    srcFolder = "C:\abc\"
    destFolder = "C:\vba\결과\취합\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(srcFolder)
    
    For Each file In folder.Files
        If InStr(file.Name, "0.85") > 0 Then
            fso.CopyFile file.Path, destFolder & file.Name
        End If
    Next file
End Sub
```

2. "요구" 시트 복사 및 새 워크북 생성

```vba
Sub CopySheets()
    Dim fso As Object
    Dim srcFolder As String, destFolder As String
    Dim file As Object, folder As Object
    Dim wb As Workbook, newWb As Workbook
    Dim sh As Worksheet, newSh As Worksheet
    Dim i As Integer

    srcFolder = "C:\vba\취합\"
    destFolder = "C:\vba\결과\취합\step1.xlsx"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(srcFolder)
    Set newWb = Workbooks.Add
    
    For Each file In folder.Files
        Set wb = Workbooks.Open(file.Path)
        
        For Each sh In wb.Sheets
            If sh.Name = "요구" Then
                sh.Copy After:=newWb.Sheets(newWb.Sheets.Count)
                Set newSh = newWb.Sheets(newWb.Sheets.Count)
                newSh.Name = fso.GetBaseName(file.Name)
                newSh.Cells(1, 1).EntireColumn.Insert
                newSh.Range("A2:A" & newSh.Cells(Rows.Count, 2).End(xlUp).Row).Value = fso.GetBaseName(file.Name)
            End If
        Next sh
        
        wb.Close False
    Next file
    
    Application.DisplayAlerts = False
    newWb.Sheets(1).Delete
    Application.DisplayAlerts = True
    
    newWb.SaveAs destFolder
    newWb.Close
End Sub
```

3. 템플릿에 데이터 복사

```vba
Sub MergeData()
    Dim templateWb As Workbook, step1Wb As Workbook
    Dim sh As Worksheet, tempSh As Worksheet
    Dim lastRow As Long, tempLastRow As Long
    
    Set templateWb = Workbooks.Open("C:\vba\template.xlsx")
    Set step1Wb = Workbooks.Open("C:\vba\결과\취합\step1.xlsx")
    Set tempSh = templateWb.Sheets("템플릿")

    tempLastRow = 2
    For Each sh In step1Wb.Sheets
        lastRow = sh.Cells(Rows.Count, 2).End(xlUp).Row
        sh.Range("A5:Z" & lastRow).Copy
        tempSh.Cells(tempLastRow, 2).PasteSpecial xlPasteValues
        tempSh.Cells(tempLastRow, 1).Resize(lastRow - 4).Value = sh.Name
        tempLastRow = tempSh.Cells(Rows.Count, 2).End(xlUp).Row + 1
    Next sh
    
    Application.CutCopyMode = False
    templateWb.SaveAs "C:\vba\결과\취합\result.xlsx"
    templateWb.Close False
    step1Wb.Close False
End Sub
```

이 코드는 각 단계를 최대한 간결하게 구성했습니다. 각 단계를 실행할 때마다 해당 서브루틴을 호출하면 됩니다. 예를 들어, 모든 단계를 한 번에 실행하려면 다음과 같이 하십시오:

```vba
Sub Main()
    CopyFiles
    CopySheets
    MergeData
End Sub
```

뤼튼 사용하러 가기 > https://agent.wrtn.ai/0ek99d