Create copy workbook with cell referencing to original

Option Explicit

Sub CreateCopiesWithNamedRangesReferencingMaster()
    'Create a new workbook named Copier.xlsm, add a standard module and put this code in it.
    'Save Copier.xlsm in the same directory as the Master file.  Copies will be created in that directory

    Dim aryCopyNames As Variant
    Dim lX As Long, lY As Long
    Dim sCopyName As String
    Dim secAutomation As MsoAutomationSecurity
    Dim sExtension As String
    Dim sMasterFileName As String
    
    'Modify the next line to contain the name of the Master workbook, be sure to include the extension
    sMasterFileName = "Master.xlsx"
    'An example for the above line would be sMasterFileName = "Master.xlsx"
    
    'Modify next line to contain names of each copy. extension will be copied from the extension in sMasterFileName
    aryCopyNames = Array("CopyAA", "CopyBB", "CopyCC")
    'An example for the above line would be aryCopyNames = Array("CopyA", "CopyB", "CopyC")

    secAutomation = Application.AutomationSecurity                          'Save ThisWorkbook security setting
    Application.AutomationSecurity = msoAutomationSecurityForceDisable      'Disable macros when opening file
    
    sExtension = Mid(sMasterFileName, InStrRev(sMasterFileName, "."))
    
    'Open the master file
    Workbooks.Open Filename:=ThisWorkbook.Path & "\" & sMasterFileName
    
    For lX = LBound(aryCopyNames) To UBound(aryCopyNames)
    
        If UCase(Right(aryCopyNames(lX), Len(sExtension))) <> UCase(sExtension) Then
            sCopyName = aryCopyNames(lX) & sExtension
        Else
            sCopyName = aryCopyNames(lX)
        End If

        'Save a copy of the master file
         Workbooks(sMasterFileName).SaveCopyAs Filename:=ThisWorkbook.Path & "\" & sCopyName
        'Open the copy
        Workbooks.Open Filename:=ThisWorkbook.Path & "\" & sCopyName
        
        'Update named ranges in the copy
        For lY = 1 To ThisWorkbook.Names.Count
            With Workbooks(sCopyName).Names(lY)
                .RefersTo = "=[Master.xlsm]" & Mid(.RefersTo, 2)
            End With
        Next
        
        'Save and close the copy
        Workbooks(sCopyName).Save
        Workbooks(sCopyName).Close
        
    Next
    
    'Close the master file
    Workbooks(sMasterFileName).Close
    
End_Sub:

    Application.AutomationSecurity = secAutomation                          'Restore ThisWorkbook security setting
    
End Sub

Sub ListNamedRanges()

    Dim lX As Long
    
    Debug.Print "====================================="
    Debug.Print "Named Ranges in: " & ActiveWorkbook.Name
    Debug.Print "====================================="
    For lX = 1 To ActiveWorkbook.Names.Count
        With ActiveWorkbook.Names(lX)
            Debug.Print "Name:           " & .Name
            Debug.Print "RefersToR1C1:   " & .RefersToR1C1
            Debug.Print "RefersTo:       " & .RefersTo
            Debug.Print "Comment:        " & .Comment
            Debug.Print "-------------------------------------"
        End With
    Next
End Sub

Sub Document_ListActiveWorkbookNamedRangesOnAWorksheet()

    Dim lX As Long
    
    'Initialize Documentation Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Document_NamedRanges").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Worksheets.Add(Before:=Sheets(1)).Name = "Document_NamedRanges"
    
    With Worksheets("Document_NamedRanges")
        .Range("A1").Resize(1, 5).Value = Array("Name", "RefersToR1C1", "RefersTo", "Value", "Comment")
        
        'Examine each named range
        For lX = 1 To ActiveWorkbook.Names.Count
            With ActiveWorkbook.Names(lX)
                Worksheets("Document_NamedRanges").Cells(lX + 1, 1).Value = .Name
                Worksheets("Document_NamedRanges").Cells(lX + 1, 2).Value = "'" & .RefersToR1C1
                Worksheets("Document_NamedRanges").Cells(lX + 1, 3).Value = "'" & .RefersTo
                Worksheets("Document_NamedRanges").Cells(lX + 1, 4).Value = .Value
                Worksheets("Document_NamedRanges").Cells(lX + 1, 5).Value = .Comment
                Debug.Print .Name, .RefersTo
            End With
        Next
        .UsedRange.Columns.AutoFit
    End With
        
End Sub