Copying Files From One Directory to Another

[Cranman2127]

Hello,

I'm trying to find all files in a directory a which match via a partial string with the value in column A, then copy them into a new directory.
I've found code that does this but only for a specific file name (1110313_a.jpg).

We'd love it if the script would find any files that contain the value in column A and copy all of them to the new directly chosen via the dialog box.

Here is the code so far:

Sub CopyFilesFromList()
'Updateby Extendoffice
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
On Error Resume Next
Set xRg = Application.InputBox("Please select the file names:", "Copy File From a List", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = "Please select the original folder:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & ""
Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDFileDlg.Title = "Please select the destination folder:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & ""
For Each xCell In xRg
xVal = xCell.Value & "_a.jpg"
If TypeName(xVal) = "String" And xVal <> "" Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
End If
Next
End Sub




Thank you for the help.