как скопировать файлы из одного места в другое, если имя этого файла существует в файле Excel

Question

У меня есть файл Excel, который содержит имена файлов изображений. В той же папке у меня есть все изображения, перечисленные в файле Excel, а также некоторые дополнительные изображения. Теперь я хочу отделить все изображения, перечисленные в файле Excel. Изображения, включенные в файл Excel, должны быть скопированы в другую папку. Я использовал метод в соответствии с указаниями автора этого поста:

https://www.extendoffice.com/documents/excel/4775-move-files-based-on-excel-list.html

Sub movefiles()
'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:", "KuTools For Excel", 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
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
            Kill xSPathStr & xVal
        End If
    Next
End Sub

, но когда я выполняю код, ничего не происходит. Есть ли способ сделать задачу?