Move files and ignore file extension?

Hello

I have a list of files that I wish to move from one folder to another. Now the problem is the list doesn't contain the file extension and there could be multiple different extensions.

I have this code that will read the first cell and add the ".txt" extension then move the file. But ideally I want the code to search the folder ,find the first six digits match the cell then add the extension of the file it found be it ".tif" ,".xls" etc etc

[VBA]Sub move_files_Adept()
Dim c As Object, x, i As Long, n As Long
Set c = CreateObject("Scripting.FileSystemObject")
oldpath = "C:\testfilesFROM\": newpath = "C:\testfilesTO\"
x = Range([a2], [a2].End(xlDown))
For i = 1 To UBound(x)
c.movefile oldpath & x(i, 1) & ".txt", newpath & x(i, 1) & ".txt"
n = n + 1
Next: MsgBox n & "files has been successfully moved", vbInformation: End Sub
[/VBA]

Any ideas?

thanks

Geoff

[vba]
Sub move_files_Adept()
Dim FSO As Object, rng As Range
Dim newpath As String
Dim i As Long, n As Long
Dim file As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
newpath = "C:\testfilesTO\"
For Each file In FSO.getfolder("C:\testfilesFROM\").Files

Set rng = Range(Range("A2"), Range("A2").End(xlDown))
If Not IsError(Application.Match(Left$(file.Name, 6), rng, 0)) Then

Name file.Path As newpath & file.Name
n = n + 1
End If
Next file

MsgBox n & "files has been successfully moved", vbInformation:
End Sub[/vba]