A liitle simpler

Sub ZoomUR()
    Dim Tmp As String
    Tmp = ActiveCell.Address
    ActiveSheet.UsedRange.Select
    ActiveWindow.Zoom = True
    Range(Tmp).Select
End Sub