指定キーワードが含まれるファイルのフルパスをリストから取得

Sub MatchKeywordsAndOutputPaths()
    Dim wsKeywords As Worksheet
    Dim wsPaths As Worksheet
    Dim lastRowKeywords As Long
    Dim lastRowPaths As Long
    Dim i As Long, j As Long
    
    ' ワークシートの設定
    Set wsKeywords = ThisWorkbook.Sheets("Sheet1")
    Set wsPaths = ThisWorkbook.Sheets("Sheet2")
    
    ' 各シートの最終行を取得
    lastRowKeywords = wsKeywords.Cells(wsKeywords.Rows.Count, "A").End(xlUp).Row
    lastRowPaths = wsPaths.Cells(wsPaths.Rows.Count, "A").End(xlUp).Row
    
    ' Sheet1のキーワードを1つずつ確認
    For i = 1 To lastRowKeywords
        Dim keyword As String
        keyword = wsKeywords.Cells(i, 1).Value
        
        ' Sheet2のパスを確認
        For j = 1 To lastRowPaths
            Dim path As String
            path = wsPaths.Cells(j, 1).Value
            
            ' キーワードがパスに含まれているかチェック
            If InStr(path, keyword) > 0 Then
                ' マッチしたらSheet1のB列にパスを出力
                wsKeywords.Cells(i, 2).Value = path
                ' 1つ見つかれば次のキーワードへ
                Exit For
            End If
        Next j
    Next i
End Sub