Learn to run a VBA code and Copy specific files from source folder to destination folder #VBA

View the comment section of this video

[whiteboard]

Sub Copyfiles()
'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
Dim fso As Object, folder1 As Object
Set xRg = Application.InputBox("Please select the file names:", "Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xSFileDlg =
xSFileDlg.Title = " Please select the original folder:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = & "\"
Set xDFileDlg =
xDFileDlg.Title = " Please select the destination folder:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = & "\"
Call sCopyFiles(xRg, xSPathStr, xDPathStr)
End Sub

Sub sCopyFiles(xRg As Range, xSPathStr As Variant, xDPathStr As Variant)
Dim xCell As Range
Dim xVal As String
Dim xFolder As Object
Dim fso As Object
Dim xF As Object
Dim xStr As String
Dim xFS As Object
Dim xI As Integer
On Error Resume Next
If Dir(xDPathStr, vbDirectory) = "" Then
MkDir (xDPathStr)
End If
For xI = 1 To xRg.Count
Set xCell = xRg.Item(xI)
xVal = xCell.Value
If TypeName(xVal) = "String" And Not (xVal = "") Then
On Error GoTo E1
If Dir(xSPathStr & xVal, 16) <> Empty Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
End If
End If
E1:
Next xI
On Error Resume Next
Set fso =
Set xFS = fso.GetFolder(xSPathStr)
For Each xF In xFS.SubFolders
xStr = xDPathStr & "\" & xF.Name
Call sCopyFiles(xRg, xF.ShortPath & "\", xStr & "\")
If = 0) _
And = 0) Then
RmDir xStr
End If
Next
End Sub

[jayakumarkanthasamy]

Can we move different files like type-, type-2, type-3 move into one specific folder like single Type. Please reply if have anything.