【VBA】特定のフォルダ内の全ファイルを部分一致で転記する方法

Option Explicit
Sub CopyMatchingFilesData()
    Dim fso As Object, folder As Object, file As Object
    Dim wb As Workbook, ws As Worksheet
    Dim filePath As String, fileName As String, searchPattern As String
    Dim lastRow As Long, i As Long
    
    ' 検索対象のフォルダパスと部分一致するファイル名を指定
    Set fso = CreateObject("Scripting.FileSystemObject")
    searchPattern = "*.txt" ' 部分一致で検索したい拡張子や文字列を設定
    filePath = "C:\test\" ' 検索対象のフォルダパスを指定
    
    Set folder = fso.GetFolder(filePath)
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 ' 最終行の次の行にデータを追加する
    Application.ScreenUpdating = False ' スクリプト実行中に画面更新を停止
    
    For Each file In folder.Files
        If InStr(file.Name, searchPattern) > 0 Then ' 部分一致でファイル名を検索
            fileName = file.Path
            Set wb = Workbooks.Open(fileName)
            With wb.Sheets(1)
                .Range("A1:B5").Copy ws.Cells(lastRow, 1) ' 指定範囲のデータをコピー
                lastRow = lastRow + 5 ' コピーした行数分、次の行に進める
            End With
            wb.Close SaveChanges:=False ' ワークブックは開いただけなので保存せずに閉じる
        End If
    Next file
    Application.ScreenUpdating = True ' スクリプト実行後に画面更新を再開
End Sub