List worksheets as named ranges

Brief description:
Full description:
			
Code:

Sub ListWorksheetsInNamedRanges()
    'Procedure to list all worksheets as named ranges for easy access
    
    Dim CurrWS As Worksheet
    Dim ThisWorkBook As Workbook
    
    Set ThisWorkBook = ActiveWorkbook
    
    For Each CurrWS In ThisWorkBook.Worksheets
        ThisWorkBook.Names.Add _
            Name:="WS_" & Replace(CurrWS.Name, " ", "_"), _
            RefersTo:="='" & CurrWS.Name & "'!" & CurrWS.Range("A1").Address
    Next CurrWS
    
End Sub