selecting all named ranges at same time

Sub SelectAllNames()
Dim i As Integer, r As Range, Bigr As Range, s As String
For i = ThisWorkbook.Names.Count To 1 Step -1
    s = ThisWorkbook.Names(i).RefersTo
    If InStr(s, ActiveSheet.Name) <> 0 Then
        Set r = Range(s)
        If Bigr Is Nothing Then
            Set Bigr = r
        Else
            Set Bigr = Application.Union(Bigr, r)
        End If
    End If
Next i
Bigr.Select
End Sub

Sub SelectAllNames()
Dim i As Integer, Bigr As Range, s As String
For i = 1 To ThisWorkbook.Names.Count
    s = ThisWorkbook.Names(i).RefersTo
    If InStr(s, ActiveSheet.Name) <> 0 Then
        If Bigr Is Nothing Then
            Set Bigr = Range(s)
        Else
            Set Bigr = Union(Bigr, Range(s))
        End If
    End If
Next i
If Not Bigr Is Nothing Then Bigr.Select
End Sub