Move only files with matching files names from one folder to another

[A Rossi]

I want to copy only the files from one folder “the FromPath” that have the same file name (with different extensions) as in another folder the “the ToPath”. Only the shared file named files will be moved. I think the code would have to first look in the ToPath folder to get the names of the files and then cross reference those in the “FromPath” folder. I want to copy only the files from one folder “the FromPath” that have the same file name (with different extensions) as in another folder the “the ToPath”. Only the shared file named files will be moved. I think the code would have to first look in the ToPath folder to get the names of the files and then cross reference those in the “FromPath” folder.

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">Private Sub CmdBtn_transfer_Click()

Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim Val As String
Dim i As Integer

FromPath = "C:\Users\rossi\Desktop\Production files" & (Me.ListBox1) '<< Change

For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
Val = ListBox2.List(i)
End If
Next i
FileExt = "*.sli*" '<< Change

If Right(FromPath, 1) <> "" Then
FromPath = FromPath & ""
End If

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If

For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) Then
ToPath = "\\bego.hb\MED_PRODUCTION\USA_Datapreparation" & (Me.ListBox2.List(i)) '<< Change

If Right(ToPath, 1) <> "" Then
ToPath = ToPath & ""
End If

If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If

FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End If
Next i

End Sub

</code>