본문 바로가기
카테고리 없음

vba 필터해제 후 처리

by 팁텍북 2024. 7. 8.



1. 특정 파일 복사
```vba
Sub CopyFiles()
    Dim fso As Object
    Dim sourceFolder As String
    Dim destFolder As String
    Dim file As Object
    Dim fileName As String
    
    sourceFolder = "C:/abc/"
    destFolder = "C:/vba/결과/취합/"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If Not fso.FolderExists(destFolder) Then
        fso.CreateFolder destFolder
    End If
    
    For Each file In fso.GetFolder(sourceFolder).Files
        If InStr(file.Name, "0.85") > 0 Then
            fileName = destFolder & file.Name
            file.Copy fileName
        End If
    Next file
End Sub
```

2. 파일 열기 및 데이터 처리
```vba
Sub ProcessFiles()
    Dim fso As Object
    Dim folderPath As String
    Dim destWb As Workbook
    Dim srcWb As Workbook
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    Dim destLastRow As Long
    Dim fileName As String
    Dim file As Object
    
    folderPath = "C:/vba/결과/취합/"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set destWb = Workbooks.Add
    
    For Each file In fso.GetFolder(folderPath).Files
        Set srcWb = Workbooks.Open(file.Path)
        For Each ws In srcWb.Worksheets
            If ws.Name = "요구" Then
                ws.AutoFilterMode = False
                lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
                If destWb.Sheets.Count = 1 And destWb.Sheets(1).Cells(1, 1) = "" Then
                    Set newWs = destWb.Sheets(1)
                Else
                    Set newWs = destWb.Sheets.Add(After:=destWb.Sheets(destWb.Sheets.Count))
                End If
                ws.Rows("1:" & lastRow).Copy Destination:=newWs.Rows("2")
                newWs.Cells(1, 1).Value = "파일명"
                newWs.Cells(2, 1).Resize(lastRow - 1).Value = file.Name
                newWs.Name = ws.Name
            End If
        Next ws
        srcWb.Close False
    Next file
    
    destWb.SaveAs "C:/vba/결과/취합/step1.xlsx"
    destWb.Close
End Sub
```

3. 템플릿에 데이터 복사 및 저장
```vba
Sub MergeToTemplate()
    Dim templateWb As Workbook
    Dim step1Wb As Workbook
    Dim templateWs As Worksheet
    Dim srcWs As Worksheet
    Dim destRow As Long
    Dim lastRow As Long
    Dim i As Long
    
    Set templateWb = Workbooks.Open("C:/vba/template.xlsx")
    Set step1Wb = Workbooks.Open("C:/vba/결과/취합/step1.xlsx")
    Set templateWs = templateWb.Sheets("템플릿")
    
    destRow = 1
    
    For Each srcWs In step1Wb.Worksheets
        lastRow = srcWs.Cells(srcWs.Rows.Count, 1).End(xlUp).Row
        If lastRow > 4 Then
            srcWs.Rows("5:" & lastRow).Copy Destination:=templateWs.Rows(destRow)
            templateWs.Cells(destRow, 1).Resize(lastRow - 4).Value = srcWs.Name
            destRow = destRow + lastRow - 4 + 1
        End If
    Next srcWs
    
    templateWb.SaveAs "C:/vba/결과/취합/result.xlsx"
    templateWb.Close
    step1Wb.Close False
End Sub
```

이제 세 가지 서브루틴을 순서대로 실행하면 됩니다. 전체 작업을 하나의 서브루틴으로 묶어서 실행할 수도 있습니다.

전체 작업 실행
```vba
Sub EntireProcess()
    Call CopyFiles
    Call ProcessFiles
    Call MergeToTemplate
End Sub
```

위 코드를 실행하면 설명한 작업을 순차적으로 수행할 수 있습니다. 각 서브루틴은 독립적으로 실행할 수도 있고, `EntireProcess` 서브루틴을 실행하여 전체 작업을 한 번에 수행할 수도 있습니다.

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

댓글