Sub GPE()
Dim N As Name, Sh As Worksheet, Rng As Range, NArr(1 To 65536, 1 To 1), i As Long, j As Long, k As Long, RngAdd As String, Pos As Long, Dic As Variant
Set Dic = CreateObject("Scripting.Dictionary")
For Each N In Names
For Each Sh In Sheets
RngAdd = ""
Set Rng = Sh.Cells.Find(N.Name, Sh.[A1], xlFormulas, 2)
If Not Rng Is Nothing Then
RngAdd = Rng.Address
Do
Set Rng = Sh.Cells.FindNext(Rng)
If Rng.HasFormula Then
k = CheckN(Rng.Formula, N.Name)
If k = 1 Then GoTo Fnext
If k = 2 Then
i = i + 1
NArr(i, 1) = N.Name
Dic.Add N.Name, ""
GoTo NextN
End If
End If
Fnext:
Loop Until Rng.Address = RngAdd
End If
Next
NextN:
Next
Dim Check As Boolean
Do
Check = False
For Each N In Names
If Not Dic.Exists(N.Name) Then
k = i
For j = 1 To k
If CheckN(ActiveWorkbook.Names(NArr(j, 1)).RefersTo, N.Name) = 2 Then
i = i + 1
NArr(i, 1) = N.Name
Dic.Add N.Name, ""
Check = True
GoTo CheckNext
End If
Next
End If
CheckNext:
Next
Loop While Check
Sheets(1).[A2:A65536].ClearContents
If i > 0 Then Sheets(1).[A2].Resize(i).Value = NArr
End Sub