Sub ListNames()
Dim nm As Name
Dim x As Integer
Dim wb As Workbook
Dim myNames()
If ActiveWorkbook.Names.Count = 0 Then
MsgBox ("No names found in active workbook.")
Exit Sub
End If
ReDim myNames(1 To ActiveWorkbook.Names.Count, 1 To 2)
For Each nm In ActiveWorkbook.Names
x = x + 1
myNames(x, 1) = nm.Name
myNames(x, 2) = "Refers To: " & nm.RefersTo
Debug.Print myNames(x, 1) & " | " & myNames(x, 2)
Next nm
Set wb = Workbooks.Add
wb.Sheets(1).Range("A1").Resize(UBound(myNames, 1), 2).Value = myNames
wb.Sheets(1).Columns("A:B").EntireColumn.AutoFit
End Sub