Actually the previously posted function was originally designed with only
one sheet in mind, and not efficient if the purpose is to get all names
sorted into arrays per sheet. Following should work faster in a wb with many
names.

Sub test2()
Dim arr

GetNamesPerSht ActiveWorkbook, arr

End Sub
Function GetNamesPerSht(wb As Workbook, aNames) As Long
Dim i As Long, j As Long, k As Long
Dim nCnt As Long
Dim nm As Name
Dim ws As Worksheet

nCnt = wb.Names.Count
GetNamesPerSht = nCnt
If nCnt = 0 Then Exit Function

ReDim arr1(1 To nCnt, 1 To 2)

On Error Resume Next 'RefersToRange error if not be a range name

' get all range names and mark with parent sheet index
For Each nm In wb.Names

Set ws = nm.RefersToRange.Parent
If Not ws Is Nothing Then
i = i + 1
arr1(i, 1) = nm.Name
arr1(i, 2) = ws.Index
Set ws = Nothing
End If

Next
On Error GoTo 0

ReDim arr2(1 To wb.Worksheets.Count) As Long
ReDim aNames(1 To wb.Worksheets.Count)

' get count of names on each sheet
For i = 1 To UBound(arr1)
arr2(arr1(i, 2)) = arr2(arr1(i, 2)) + 1
Next

'sift names into an array for each sheet
' and add to an array of arrays
For i = 1 To wb.Worksheets.Count
If arr2(i) Then
ReDim arr3(1 To arr2(i))
k = 0
For j = 1 To UBound(arr1)
If i = arr1(j, 2) Then
k = k + 1
arr3(k) = arr1(j, 1)
End If
Next
aNames(i) = arr3
End If
Next

End Function

Regards,
Peter T

"Peter T" <peter_t@discussions wrote in message
...
You didn't search very hard <g, here's one posted just a week ago that
appears to do what you want.

Sub test()
Dim ws As Worksheet
Dim arr
ReDim aNames(1 To Worksheets.Count)

For Each ws In ActiveWorkbook.Worksheets
i = i + 1
GetNames ws, arr
aNames(i) = arr
Next

End Sub

Function GetNames(oWsht As Worksheet, arr)
Dim i As Long
Dim nm As Name
Dim ws As Worksheet
ReDim arr(1 To oWsht.Parent.Names.Count)

On Error Resume Next 'RefersToRange error if not be a range name
For Each nm In oWsht.Parent.Names
' If InStr(nm.Name, "!") = 0 Then ' not local
Set ws = nm.RefersToRange.Parent
If Not ws Is Nothing Then
If ws Is oWsht Then
i = i + 1
arr(i) = nm.Name
Set ws = Nothing
End If
End If
' End If
Next
If i Then
ReDim Preserve arr(1 To i)
End If
GetNames = i
End Function

In the other thread the OP didn't want to include worksheet level names, I
assume you will hence the commented If test.

Regards,
Peter T


"LetMeDoIt" wrote in message
...
Greetings,
I've search several websites (including this forum) and cannot find
any VBA code to perform the following:

I need to populate an array with named ranges. Basically, I need to
search a sheet for defined named ranges, and once found, copy it to
array(i), then on to the next one.

Any help is greatly appreciated....