Automatic saving to multiple destination.

[Olyn01]

Is it possible to save your workbook to 2 destinations?
When I try to put 2 destination on VB it doesn't work.

Sub SaveAs()


    Dim FName           As String
    Dim FPath           As String
    Dim NewBook         As Workbook
    
Application.ScreenUpdating = False
    FPath = "C:\Users\ROOM\Desktop\Monitoring\"
    FName = "Monitoring " & Format(Date, "DD-MMM-YYYY") & ".xls"
      
    Set NewBook = Workbooks.Add
    
    ThisWorkbook.Sheets("MasterCopy").Copy Before:=NewBook.Sheets(1)
    
    If Dir(FPath & "\" & FName) <> "" Then
        MsgBox "File" & FPath & "\" & FName & "already exists"
    Else
        NewBook.SaveAs Filename:=FPath & FName
    End If
Application.ScreenUpdating = True


Application.ScreenUpdating = False
Workbooks("Monitoring " & Format(Date, "DD-MMM-YYYY") & ".xls").Close SaveChanges:=True
Application.ScreenUpdating = True

 

[Logit]

.

Option Explicit


Sub sb_Copy_Save_ActiveSheet_As_Workbook()
Dim wb As Workbook
Set wb = Workbooks.Add
ThisWorkbook.Activate
ThisWorkbook.Worksheets("Sheet1").Range("A1:K10").Copy
wb.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues)


wb.SaveAs "C:\Users\My\desktop\New Folder\" & Range("H1").Value & ".xlsx"   '<---- change save location & name here


wb.SaveAs "C:\Users\My\desktop\Other\" & Range("H1").Value & ".xlsx"   '<---- change save location & name here
End Sub

 

[DanteAmor]

Continuing with your idea.
put your destination 2 in the red letters
Note: the newbook must be closed until the end, since you have saved the 2 books

Sub SaveAs()
    Dim fName           As String
    Dim fPath1          As String, fPath2 As String
    Dim NewBook         As Workbook
    
    Application.ScreenUpdating = False
    fPath1 = "C:\Users\ROOM\Desktop\Monitoring\"
    fPath2 = "[COLOR=#ff0000]C:\trabajo\books\[/COLOR]"
    fName = "Monitoring " & Format(Date, "DD-MMM-YYYY") & ".xls"
      
    Set NewBook = Workbooks.Add
    
    ThisWorkbook.Sheets("MasterCopy").Copy Before:=NewBook.Sheets(1)
    
    'save in path1
    If Dir(fPath1 & fName) <> "" Then
        MsgBox "File " & fPath1  & fName & " already exists"
    Else
        NewBook.SaveAs Filename:=fPath1 & fName
    End If
    
    'save in path2
    If Dir(fPath2 & fName) <> "" Then
        MsgBox "File " & fPath2 & fName & " already exists"
    Else
        NewBook.SaveAs Filename:=fPath2 & fName
    End If
    
    NewBook.Close SaveChanges:=False
    Application.ScreenUpdating = True
End Sub

 

[Olyn01]

Thank you!

 

[Logit]

.
You are welcome.

 

[DanteAmor]

You're welcome & thanks for the feedback.