Adding Name Range to this macro

[Sunnyskies]

Afternoon,

I have this macro:

Sub NameSheets()
'will add a sheet, and name it
'for each name in column A
'from A1 down till it hits a blank row
Dim Rng As Range
Dim ListRng As Range
Set ListRng = Range(Range("A1"), Range("A1").End(xlDown))
For Each Rng In ListRng
If Rng.Text <> "" Then
With Worksheets
..Add(after:=.Item(.Count)).Name = Rng.Text
End With
End If
Next Rng
End Sub

Which creates the number of sheets according to the number of names I have
listed.

Now I have a formula above the names:

=IF($B$3<>"",ADDRESS(ROW($B$3),COLUMN($B$3),1)&":"&ADDRESS(ROW($B$3)+COUNTA($B$3:$B$104)-1,COLUMN($B$3)),"")

To only count the number of names that are listed, because the number of
names will change month to month.
If I create a Name Range over this formula and substitute the Name Range in
place of A1 in the macro, it comes back with an error about having entered an
invalid name try name not exceeding 31 characters (NameRange is what I have
used), make sure name does not contain : \ / ? * [ or ]

So I ask if someone can assist in inserting a name range instead of A1 as
the number of names will change month to month.

Thanks