find list of files in different subfolder and move them to one folder

[CobraLAD]

Good day

This code works if you do it manually

Function Recurse(sPath As String) As String

    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim mySubFolder As Folder
    Dim myFile As file

    Set myFolder = FSO.GetFolder(sPath)

    For Each mySubFolder In myFolder.SubFolders
        For Each myFile In mySubFolder.Files
            If myFile.Name = Range("A1").Value & ".jpg" Then
                Range("A1").Offset(0, 1).Value = "Found"
                Name myFile.Path As "F:\Covers 1000\" & Range("A1").Value & ".jpg"
                Exit For
            End If
        Next
        Recurse = Recurse(mySubFolder.Path)
    Next

End Function

Sub TestR()

    Call Recurse("F:\zCovers")

End Sub

but I want to loop through a list in column A which sometimes can be long
trying to use this, but does not work. Please help to fix

Function Recurse(sPath As String) As String

    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim mySubFolder As Folder
    Dim myFile As file
    Dim i As Long
    Set myFolder = FSO.GetFolder(sPath)

    For Each mySubFolder In myFolder.SubFolders
        For Each myFile In mySubFolder.Files
            For i = 1 To Sheet1.Range("A1").End(xlDown).Row
                If myFile.Name = Cells(i, 1).Value & ".jpg" Then
                    Cells(i, 1).Offset(0, 1).Value = "Found"
                    Name myFile.Path As "F:\Covers 1000\" & Cells(i, 1).Value & ".jpg"
                End If
            Next i
        Exit For
        Next myFile
        Recurse = Recurse(mySubFolder.Path)
    Next mySubFolder
    Set FSO = Nothing
End Function

Sub TestR()

    Call Recurse("F:\zCovers")

End Sub