Paste excel doc to many folders

[ipbr21054]

Hi,

is it possible to paste an excel doc to many folders.
Currently im doing it manually to each & every folder which takes up to much time.
It would also need to overwrite the same named file in the folder its being pasted to

Thanks

 

[vds1]

This can be achieved using VBA. Try FileCopy function.

https://www.rondebruin.nl/win/s3/win026.htm

 

[ipbr21054]

Many thanks for that.
I believe i have selected the code that i require & have edited the file paths as needed.

Basically i have one file template that when i make an edit to i then paste it into several folders.

In the code below you will see that the template code at present will be pasted only into the folder named 06 JUNE.
Because i need to laos paste to other folders i am not sure how to edit the code so it also pastes into the folders mentioned below.

07 JULY
08 AUGUST
09 SEPTEMBER
ETC TEC

Can you advise please.

Sub Copy_Certain_Files_In_Folder()
'This example copy all Excel files from FromPath to ToPath.
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
 
    FromPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS
    ToPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\06 JUNE
 
    FileExt = "*.xl*"  '<< Change
    'You can use *.* for all files or *.doc for Word files
 
    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If
 
    Set FSO = CreateObject("scripting.filesystemobject")
 
    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If
 
    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If
 
    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath
 
End Sub

 

[vds1]

You can call that procedure and run for different folder.. like this

Sub Move_File_MultiFolder()


    Dim FromPath As String
    Dim ToPath As String
    
    FromPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS"
    
    '// Folder 1
    ToPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\06 JUNE"
    Call Copy_Certain_Files_In_Folder(FromPath, ToPath)
    
    '// Folder 2
    ToPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\07 JUlY"
    Call Copy_Certain_Files_In_Folder(FromPath, ToPath)
    
    '// Folder 3
    ToPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\08 AUGUST"
    Call Copy_Certain_Files_In_Folder(FromPath, ToPath)
    
    '// So on....


End Sub








Private Sub Copy_Certain_Files_In_Folder(FromPath As String, ToPath As String)
'This example copy all Excel files from FromPath to ToPath.
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
    Dim FSO As Object
    'Dim FromPath As String
    'Dim ToPath As String
    Dim FileExt As String
 
    'FromPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS"
    'ToPath = "C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\06 JUNE"
 
    FileExt = "*.xl*"  '<< Change
    'You can use *.* for all files or *.doc for Word files
 
    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If
 
    Set FSO = CreateObject("scripting.filesystemobject")
 
    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If
 
    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If
 
    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath
 
End Sub

 

[ipbr21054]

Thanks very much