Copy files from one folder and subfolder to another based on a list in Excel

Sub copyfiles()
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
SetxRg = 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
End If
Next
End Sub

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub copyfiles()
Dim xRg As Range, xCell As Range
Dim fldr As Object
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    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) & vbNullString
    
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = "Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & vbNullString
    
    CopySelected xSPathStr, xDPathStr, xRg
    For Each fldr In CreateObject("Scripting.FileSystemObject").GetFolder(xDPathStr & Application.PathSeparator).subFolders
    
        CopySelected fldr.Path, xDPathStr, xRg
    Next fldr[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Function CopySelected( _
    ByVal OrigPath As String, _
    ByVal DestPath As String, _
    ByRef rng As Range)
Dim xCell As Range
Dim xVal As String[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    For Each xCell In rng
    
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
        
            FileCopy OrigPath & Application.PathSeparato & xVal, DestPath & Application.PathSeparator & xVal
        End If
    Next
End Function
[/FONT]