Create multiple ranges based on an index of values that are also used as range names

How about this:

Sub CreateNames()
Dim rngA As Range, myStr As String, a As Long

With ActiveSheet
    Set rngA = .Range("A:A").SpecialCells(xlConstants)
    
    For a = 1 To rngA.Areas.Count
        myStr = "'" & .Name & "'!R" & rngA.Areas(a).Cells(1).Row & "C1"
        ActiveWorkbook.Names.Add Name:=rngA.Areas(a).Cells(1).Value, RefersToR1C1:="=OFFSET(" & myStr & ", , ,7, 40)"
    Next a
End With

End Sub