Rename named regions depending on worksheet they relate

Im trying to rename my named regions(~400) to have their worksheet name as suffix.

How should I properly do this?

I have following code now:

Sub ChangeNamedRegions()

    Dim oldRegionName  As String
    Dim newRegionName  As String

    For Each ws In ActiveWorkbook.Worksheets
        For Each n In ActiveWorkbook.Names
            ' If Range(n).Formula Like "=" + ws.Name + "*" Then
            If Range(n).Worksheet = ws Then
                oldRegionName = Range(n).Name
                newRegionName = ws.Name + oldRegionName

                ActiveWorkbook(oldRegionName).Name = newRegionName
                With ActiveWorkbook
                    .Names(oldRegionName).Delete
                End With

            End If
        Next n
    Next ws

End Sub

Thanks in advance!