How to loop through named range label automatically

Question

I have same many Named Range in my wsI with different label (list with different row number but same column number) (es. listA=Sheet1!$A$2:$E$4, listB=Sheet1!$A$5:$E$6 etc). Now I want to copy my Named Range in a wsO, this code works as I expect:

 Sub CopyNamedRange()
 Dim wsI As Worksheet, wsO As Worksheet

 Set wsI = ThisWorkbook.Sheets("Sheet1")
 Set wsO = ThisWorkbook.Sheets("Sheet2")

 wsO.Range("A1")= "listA"
 wsO.Range("listA").Copy wsO.Range("B1") 

 End Sub

The result is to copy listA cells from the Sheet1!$A$2:$E$4 to Sheet2!$B$1:$F$3 if in Sheet2!A1 was write "listA". Now, I want to know if it's possible to create a macro that loop through all my labels of the Named Range in wsI and according to the value in Sheet2!A1, copy all the cells. Secondly, I will introduce a second loop through the Column "A" on Sheet2 in order to find all the different "listX" (es. listA, listB, listA, listC, listB, etc.) and copy automatically the cells in the Sheet2 (obviously if A1=listA will be occupy 3 rows from 1 to 3 the next cell in column A with a "listX" will be in A4 and so on).

Answer 1

This is how:

Option Explicit
Sub Test()

    Dim MyNAmes As Name

    For Each MyNAmes In ThisWorkbook.Names
        'Your code
    Next MyNAmes

End Sub

Answer 2

Here the code for my question, if anyone is interested:

  Option Explicit
  Sub Protocols()
  ActiveSheet.UsedRange.Select
  Dim wsI As Worksheet, wsO As Worksheet
  Dim cell As Range
  Dim nm As Name

  Set wsI = ThisWorkbook.Sheets("Sheet1")
  Set wsO = ThisWorkbook.Sheets("Sheet2")

  On Error Resume Next

  For Each cell In Columns("A").Cells
  If IsEmpty(cell) = True Then
  Else
  For Each nm In ThisWorkbook.Names
  If cell.Value = nm.Name Then Exit For
  Next nm
  wsI.Range(nm.Name).Copy wsO.Cells(cell.Row, "B")
  End If
  Next cell

  On Error GoTo 0
  End Sub

Now the doubt is: it's possible to limit the nm Name searching only in the Named Range stored in Sheet1 (wsI in the example) instead of the whole workbook? I tried to replace

  For Each nm In ThisWorkbook.Names

with

  For Each nm In wsI.Names   

But it seems not work.

Any ideas? Do you think it was possible?

P.S.: It's just to limit the research to the Named Range and avoid unecessary loop!