Copy Files from One Location to Another folder or directory in Excel VBA

[mrlionsss]

I have the following code which copies an Excel file from one destination to another.

Sub sbCopyingAFile()

Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String

'This is a File Name which I want to Copy
sFile = "report 1.2.2020_updated.xlsm"

'Source folder path
sSFolder = "C:\Users\Admin\Documents\report\2020\"

'Destination folder path
sDFolder = "C:\Users\Admin\Documents\files\Client1\"

'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

The destination folder is fixed now and the code works great, but i actually have a hundreds of these destination folders that i need the file copied to. I have a list of the folder names in the column A, beginning with A1 (e.g. Client1, Client2, Client3...). The path before that is always the same - C:\Users\Admin\Documents\files\

Is it possible that the macro goes through the list and copies and pastes the file in the corresponding folders listed?

Tried this on my own, but i'm not sure how to loop this.

Any help is appreciated!

 

[NdNoviceHlp]

Maybe something like this...

Sub test()
Dim Lastrow As Integer, Cnt As Integer
With Sheets("Sheet1")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
For Cnt = 1 To Lastrow
Call sbCopyingAFile(CStr(.Range("A" & Cnt).Value))
Next Cnt
End With
End Sub


Function sbCopyingAFile(ClientName As String)

Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String

'This is a File Name which I want to Copy
sFile = "report 1.2.2020_updated.xlsm"

'Source folder path
sSFolder = "C:\Users\Admin\Documents\report\2020\"

'Destination folder path
'sDFolder = "C:\Users\Admin\Documents\files\Client1\"
sDFolder = "C:\Users\Admin\Documents\files\" & ClientName & "\"

'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 Function

HTH. Dave
ps. I'm guessing U may want to alter/delete your msgboxes

 

[mrlionsss]

Nice! Thanks a lot!

Yeah, the msgboxes will go, once it's running.

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Be safe. Dave