VBA Code to SaveAs file in one location, and backup to another location

Hello,

I have a code where when user selects SaveAs, it will automatically direct the user to the intended path and intended filename populated in saveas dialog box.

How do I save a copy to another location using the same function? So it will have 2 copies living in 2 separate directories?

I am assuming i have to run SaveAs and Save simultaneously but cant figure this out to save my life so some help would be greatly appreciated.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim vFilename As Variant
Dim vPath As Variant

'Disable events so "new save" doesn't re-trigger this event
Application.EnableEvents = False

If SaveAsUI = True Then ' User selected SaveAs instead of Save

    Cancel = True ' Cancel the user's original save action
    
        'This will make this shared before saving.
        If Not ActiveWorkbook.MultiUserEditing Then
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs ActiveWorkbook.Name, accessmode:=xlShared
        Application.DisplayAlerts = True
      
    End If
    
    Application.DisplayAlerts = False
    
    vPath1 = "\\tarcds01\eCTD_Submission\TRACKERS\" & Sheet1.Range("Q1").Value & "\" & Sheet1.Range("R1").Value & "\"
    vPath2 = Sheet1.Range("Q1").Value & "-" & Sheet1.Range("R1").Value & "-" & Sheet1.Range("S1").Value
 
    'Simulate built in "SaveAs", Use desired "IntialFilename" & filter
    vFilename = Application.GetSaveAsFilename(InitialFileName:=vPath1 & vPath2, fileFilter:="Regeneron Excel Macro-Enabled Worksheet (*.xlsm), *.xlsm")
    
    If vFilename <> False Then

        'Save file with desired parameters
        ThisWorkbook.SaveAs Filename:=vFilename, FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Use desired FileFormat
        
    End If
    
    Debug.Print vFilename
    
    Application.DisplayAlerts = True
    
End If