여러 통합 문서를 살펴볼 코드 변경

Question

현재 아래 코드가 있으며 현재 스프레드 시트 대신 현재 C 드라이브의 폴더에 저장된 여러 통합 문서를 살펴보고 싶습니다.

Sub Test() 

Dim wb1 As Workbook, wb2 As Workbook 
Dim ws1 As Worksheet, ws2 As Worksheet 
Dim copyFrom As Range 
Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel 
Dim strSearch As String 

Set wb1 = ThisWorkbook 
' Application.Workbooks.Open("C:\Sample.xlsx") 
Set ws1 = wb1.Worksheets("FCA") 

strSearch = ActiveSheet.inputname.Text 



With ws1 

    '~~> Remove any filters 
    .AutoFilterMode = False 

    lRow = .Range("H" & .Rows.Count).End(xlUp).Row 

    With .Range("H1:H" & lRow) 
     .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*" 
     Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow 
    End With 

    '~~> Remove any filters 
    .AutoFilterMode = False 
End With 

'~~> Destination File 
Set ws2 = wb1.Worksheets("Output") 

With ws2 
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then 
     lRow = .Cells.Find(What:="*", _ 
         After:=.Range("H1"), _ 
         Lookat:=xlPart, _ 
         LookIn:=xlFormulas, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlPrevious, _ 
         MatchCase:=False).Row + 1 
    Else 
     lRow = 1 
    End If 

    copyFrom.Copy .Rows(lRow) 
End With 


End Sub 

Answer 1

Sub LoopThroughFiles() 
    Dim path As String 
    Dim filename As String 
    Dim wb As Workbook 
    path = "" 'your folder path here 
    filename = Dir(path & "*.xls") 

    While (filename <> "") 
     Set wb = Workbooks.Open(path & filename) 
     'Your code goes here 
     wb.Close 
     filename = Dir 
    Wend 
End Sub