try
Sub test()
Dim ws As Worksheet, x As Name, nArray() As String
Dim i As Integer, z As String, y As String
For Each ws In Sheets
With ws
For Each x In ThisWorkbook.Names
z = Replace(Replace(Replace(x.RefersTo, "'", "") _
, "=", ""), "!", "")
y = Left(z, InStr(z, "$") - 1)
If y = .Name Then
i = i + 1: ReDim Preserve nArray(1 To i)
nArray(i) = x.Name & vbTab & ": " & _
Replace(z, .Name, "")
End If
Next
If i 0 Then
MsgBox "Found " & i & " Named range(s) on " & .Name _
& vbLf & vbLf & "Name" & vbTab & ": " & "Address" & _
vbLf & Join(nArray, vbLf)
Else
MsgBox "No named range found on " & .Name
End If
End With
Erase nArray: i = 0
Next
End Sub