Преобразование области именованного диапазона из рабочего листа в книгу путем перезаписи работает только для некоторых именованных диапазонов

Question

Я взломал код (из нескольких источников, ссылки внизу), который программно берет именованные диапазоны с областью действия листа и преобразует их в именованные диапазоны книги. Однако мой код работает только для некоторых именованных диапазонов, а не для других, и я не могу понять, почему.

Причина, по которой мне приходится это делать, заключается в том, что мне пришлось удалить две вкладки (одну из вкладок содержащий _T и другой _X) из исходного источника и скопируйте дубликаты этих вкладок из другого источника. Это оставляет меня с именованными диапазонами с областью действия книги #REF! #REF и именованными диапазонами рабочего листа, которые имеют диапазоны, которые я хочу, но они мне нужны с областью действия книги.

См. Код ниже

Если я запускаю этот код в поисках «_T», он работает отлично. Все именованные диапазоны книги, начинающиеся с _T, которые были #REF! #REF, теперь имеют правильный диапазон, а соответствующие им диапазоны рабочих листов удалены. ОДНАКО, если я запустил это в поисках "_X", рабочая книга с именем range не изменится. Я в тупике. Я даже пробовал другой подход, когда я вручную удаляю все диапазоны текущей книги, начиная с _X, а затем программно пытаюсь добавить их, используя ActiveWorkbook.Names.Add Name:=newNm,RefersTo:=nm.RefersTo, который также ничего не делает (даже не добавляет новую запись).

Заранее благодарим за помощь.

Sub WStoWBscope()

Dim nm As Name, Ans As Integer, newNm As String, fltr As String

fltr = "_X" 'search string


For Each nm In ActiveWorkbook.Names                'look at all named ranges within the current workbook
    If nm.Name Like "X!*" Then                     'looks for worksheet scoped named range that has the correct range
        If InStr(1, nm.Name, fltr) > 0 Then
            newNm = Replace(nm.Name, "X!", "")     'save name of existing workbook named range
            Range(nm.RefersTo).Name = newNm        'overwrite workbook named range with proper range
            nm.Delete                              'deletes worksheet named range
        End If
    End If
Next nm
End Sub

VBA для преобразования книги именованных диапазонов в область рабочего листа VBA для изменения объема именованных диапазонов из рабочего листа уровень к трудовой книжке

Answer 1

Просто для целей документации ( не голосуйте за это, проголосуйте за ответ Виктора ) вот как выглядит окончательная версия кода:

Dim nm As Name, Ans As Integer, newNm As String, fltr As String, rngName As Range

'Filter named ranges that contain specific phrase
fltr = "_X"

'Search for all names in the workbook
For Each nm In ActiveWorkbook.Names
    'Search within those named ranges by those that have a specific worksheet scope
    If nm.Name Like "X!*" Then
        'Search for the named ranges of a type set by your filter (fltr)
        If InStr(1, nm.Name, fltr) > 0 Then
            'Take the full name [Scope]+[named range] and remove the scope
            newNm = Replace(nm.Name, "X!", "")
            'save the original range used by the worksheet-scoped named range 
            Set rngName = Range(nm)
            'delete the worksheet-scoped named range
            nm.Delete    
            'Create/Overwrite a workbook-scoped named range (this does overwrite any workbook-scoped named ranges that are the same name with #REF!#REF )
            ThisWorkbook.Names.Add Name:=newNm, RefersToR1C1:="=" & rngName.Address(ReferenceStyle:=xlR1C1)
        End If
    End If
Next nm
End Sub

Answer 2

Попробуйте следующее:

Sub ConvertWorksheetNamedRangesToWorkbookNamedRanges()
    Dim nName As Name
    'Loop Through each named Range
    For Each nName In ActiveWorkbook.Names
        'Is Name scoped at the Workbook level?
        If TypeOf nName.Parent Is Workbook Then

        End If
        'Is Name scoped at the Worksheet level?
        If TypeOf nName.Parent Is Worksheet Then
            ' If nm.Name Like "X!*" Then .....
            ' Do the filtering you need
            ' ....
                Dim sName As String
                sName = nName.Name 'Save the name of the name
                Dim rngName As Range
                Set rngName = Range(nName) ' Save the range of the name
                nName.delete    ' Delete the name
                'Create a new one on workbook scope
                ThisWorkbook.Names.Add Name:=sName, RefersToR1C1:="=" & rngName.Address(ReferenceStyle:=xlR1C1)
            ' End If
        End If
    Next nName
End Sub