Add Named Ranges To Multiple Workbooks Using VBA

[Excel Fox]

Stalker, this isn't very specific to what you've asked, but I am mostly certain that this can do the trick. If you can get the way this works, it should be a straightforward thing to do. Check the macro. You can modify it to suit your need. If you think it will suit your purpose, you can download the file.

Option Explicit

Sub AddCusNames()
    
    'Adds all listed names from this workbook to other workbooks
    Dim nm As Name
    Dim lng As Long
    Dim lngList As Long
    Dim var As Variant
    var = ThisWorkbook.Sheets(1).ListBoxes("lstWorkBooks").List
    For lngList = LBound(var) To UBound(var)
        If ThisWorkbook.Sheets(1).ListBoxes("lstWorkBooks").Selected(lngList) Then
            With ThisWorkbook.Sheets(1)
                For lng = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
                    If .Cells(lng, 4).Value = "Worksheet" Then
                        Call Application.Workbooks(var(lngList)).Worksheets(.Cells(lng, 3).Value).Names.Add(.Cells(lng, 1).Value, .Cells(lng, 2).Value)
                    Else
                        Call Application.Workbooks(var(lngList)).Names.Add(.Cells(lng, 1).Value, .Cells(lng, 2).Value)
                    End If
                Next lng
            End With
        End If
    Next lngList
    
End Sub

Sub GetWbks()

    'Get a list of ALL open workbooks
    Dim wbk As Workbook
    With ThisWorkbook.Sheets(1).ListBoxes("lstWorkBooks")
        .RemoveAllItems
        For Each wbk In Application.Workbooks
            If (wbk.Name <> ThisWorkbook.Name) And (Not wbk.IsAddin) And (wbk.Path <> Application.StartupPath) Then
                .AddItem wbk.Name
            End If
        Next wbk
    End With
    
End Sub
    
Sub GetNms()

    'Get the names of all named ranges in any selected workbook
    Dim nm As Name
    Dim wbk As Workbook
    Dim var As Variant
    Dim lng As Long
    
    On Error GoTo eRRh
    Set wbk = Workbooks.Open(Application.GetOpenFilename("*.xl*", , "Select File", , False), False, True)
    ReDim var(1 To ThisWorkbook.Names.Count, 1 To 4)
    For Each nm In ThisWorkbook.Names
        lng = lng + 1
        If InStr(1, nm.Name, "!") Then
            var(lng, 1) = Split(nm.Name, "!")(1)
        Else
            var(lng, 1) = nm.Name
        End If
        var(lng, 2) = "'" & nm.RefersTo
        If nm.Parent.Name = ThisWorkbook.Name Then
            var(lng, 3) = nm.RefersToRange.Parent.Name
            var(lng, 4) = "Workbook"
        Else
            var(lng, 3) = nm.Parent.Name
            var(lng, 4) = "Worksheet"
        End If
    Next nm
    ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(var), 4).Value = var
    wbk.Close 0
    Exit Sub
eRRh:    MsgBox "Unexpected Error!", vbExclamation, ""
    
End Sub

You can even manually update the list of names in the sheet (be sure you are 100% accurate in filling at the four properties of the named range, including taking care of the apostrophes (') )