VBA to match list of files in windows folder and copy all to another folder

[fotodj]

With the code below I can find file named Sample1.jpg in folder located in "C:\Source\" and copy it to new location "D:\Job\".
How can I make a loop to copy all the files listed in Sheet1 in Colum G

'In this Example I am Copying the File From "C:Temp" Folder to "D:Job" Folder
Sub MatchCopyAFile()

'Declare Variables
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String

'This is Your File Name which you want to Copy
sFile = "Sample1.jpg"

'Change to match the source folder path
sSFolder = "C:\Source\"

'Change to match the destination folder path
sDFolder = "D:\Job\"

'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & sFile) Then
    MsgBox "Specified File Not Found", vbInformation, "Not Found"
   
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
    FSO.CopyFile (sSFolder & sFile), sDFolder, True
    MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
Else
    MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If

End Sub

 

[rollis13]

Add these few lines of code to your macro. I'm assuming that the file names in column G are complete of estension and that in row 1 you have a header (adjust macro if necessary).

Option Explicit
'In this Example I am Copying the File From "C:Temp" Folder to "D:Job" Folder
Sub MatchCopyAFile()
    'Declare Variables
    Dim FSO
    Dim sFile  As String
    Dim sSFolder As String
    Dim sDFolder As String
    Dim LR     As Long                            'last row column G   '<- added
    Dim x      As Long                            'generic counter for loop    '<- added
    'Change to match the source folder path
    sSFolder = "C:\Source\"
    'Change to match the destination folder path
    sDFolder = "D:\Job\"
    'Create Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    LR = Range("G" & Rows.Count).End(xlUp).Row    '<- added
    For x = 2 To LR                               '<- added (starts from row 2 because header in row 1)
        'This is Your File Name which you want to Copy
        sFile = Cells(x, "G")                     '<- changed
        'Checking If File Is Located in the Source Folder
        If Not FSO.FileExists(sSFolder & sFile) Then
            MsgBox "Specified File Not Found", vbInformation, "Not Found"
            'Copying If the Same File is Not Located in the Destination Folder
        ElseIf Not FSO.FileExists(sDFolder & sFile) Then
            FSO.CopyFile (sSFolder & sFile), sDFolder, True
            MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
        Else
            MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
        End If
    Next x                                        '<- added
    MsgBox "Done!"                                '<- added
End Sub

 

[fotodj]

Thank you rollis13, loop works very well.

 

[rollis13]

Thanks for the positive feedback, glad having been of some help.