'검색어가 포함된 모든 엑셀파일(파일명,시트명,셀주소,내용) 출력하기

'순서
'1. 폴더를 선택
'2. 폴더내에 존재하는 *.xls* 파일을 하나씩 오픈한후
'3. 1번 시트부터 마지막시트까지 검색하면서 결과 출력
'4. 파일닫고 다음파일
'5. 2~4번 반복수행

'
'Source by 땡큐엑셀vba & 엑셀매크로
'
Sub 폴더내검색()
    Dim sht As Worksheet
    Dim wsht As Worksheet '결과기록 시트
    Dim strAddr As String
    Dim rng As Range
    Dim findString As String '찾을값
    
    findString = Cells(1, "B") '찾을값
    Set wsht = ActiveSheet '결과기록 시트
    
     
    If findString = "" Then Exit Sub '검색어를 입력안한 경우 종료
    Application.ScreenUpdating = False '화면 업데이트 정지
    
    
    Range("A2:Z" & Rows.Count).Clear '검색결과를 기록하기 위하여 b1:Z 마지막 셀까지 Clear
    

    
    '1.폴더 선택
    With Application.FileDialog(msoFileDialogFolderPicker)  '폴더선택
        .Show                                               '선택창 띄우기
 
        If .SelectedItems.Count = 0 Then          '취소 선택시 종료
            Exit Sub
        Else                                      '폴더를 선택한 경우
            strPath = .SelectedItems(1) & "\"     '폴더 경로를 변수에 넣음
        End If
    End With
    
    
    ' 폴더내 파일 유무 확인
    fileName = Dir(strPath & "*.xls*")            '엑셀파일만 검색
 
    If fileName = "" Then                         '파일이 없으면
        MsgBox "파일이 없습니다.", vbInformation, "땡큐엑셀vba"               '메시지 출력후 종료
        Exit Sub
    End If
    
    
    
    Do While fileName <> ""                       '파일이 존재하면
        xlfile = strPath & fileName     '파일명을 포함한 전제경로를 변수에 넣음
        
        '2.파일오픈
        Workbooks.Open fileName:=xlfile, UpdateLinks:=False, ReadOnly:=True '읽기 전용및 업데이트 안하는 조건으로 파일오픈
    
    
        '3.전체 시트를 돌면서 검색
        For Each sht In Sheets
            With sht.Cells '시트의 전체셀
            
                Set rng = .Find(what:=findString, lookat:=xlPart) '검색

                
                If Not rng Is Nothing Then '검색결과가 있다면
                    strAddr = rng.Address  '첫 위치를 기록
                    
                    '한 시트에서 검색결과가 없을때 까지 루프
                    Do
                        
                        wsht.Cells(Rows.Count, "A").End(3)(2) = fileName    'A열 : 파일명
                        wsht.Cells(Rows.Count, "B").End(3)(2) = sht.Name    'B열 : 시트명
                        wsht.Cells(Rows.Count, "C").End(3)(2) = rng.Address 'C열 : 셀주소
                        wsht.Cells(Rows.Count, "D").End(3)(2) = rng         'D열 : 셀내용
                        
                        Set rng = .FindNext(rng)    '다음으로
                    Loop While Not rng Is Nothing And rng.Address <> strAddr
                End If
                
            End With
        Next
        
    
        '4.파일닫기
        Workbooks(fileName).Close savechanges:=False '파일닫기
    
        fileName = Dir                               '다음파일
        
    Loop
    
    
    wsht.Columns.AutoFit              '열너비 자동 맞춤
    Application.ScreenUpdating = True '화면 업데이트 재개
    
    



    '종료 메시지
    MsgBox "완료되었습니다.", vbInformation, "땡큐엑셀vba & 엑셀매크로"
    
End Sub