Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Target.Cells.Count > 1 Then Exit Sub   'выделено больше одной ячейки
   If Not Intersect(Target, Range("D5:D100")) Is Nothing Then
     If SheetExist(Target.Text) Then
       Worksheets(Target.Text).Activate
     Else
       MsgBox "В книге нет листа: " & Target.Text
     End If
   End If
End Sub

Function SheetExist(iName As String) As Boolean
'функция проверки наличия листа в книге. Если есть, то TRUE, если нет, то FALSE
    On Error Resume Next
    With Worksheets(iName): End With
    SheetExist = (Err = 0)
End Function