InputBox automatisch OK

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A3:A154")) Is Nothing Then
Cancel = True
'Cancel = Not Target.Column = 1
Sheets("MA").Activate
Suche_Namen Target
End If
End Sub

Option Explicit
Sub Suche_Namen(ByVal strSuch As String)
Dim iIndex%, strSuch_Name$
Dim vntSheets As Variant
Dim lngCalc As Long
On Error GoTo ErrExit
Call BlattSchutz_Aufheben
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
vntSheets = Array("Jänner", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", _
"September", "Oktober", "November", "Dezember")
strSuch_Name = InputBox("Geben Sie den Namen ein den Sie suchen möchten", "Namen suchen", _
strSuch)
If StrPtr(strSuch_Name) = 0 Then GoTo ErrExit
With Worksheets("MA")
For iIndex = 0 To UBound(vntSheets)
.Rows(iIndex * 4 + 3).ClearContents
Find_And_Copy Worksheets(vntSheets(iIndex)).Columns(1), strSuch_Name, .Cells(iIndex * 4 +  _
_
3, 1)
Next
End With
ErrExit:
With Err
If .Number  0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'Suche_Namen'" & vbLf & String(60, "_") & vbLf &  _
_
vbLf & _
IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & "Fehlernummer:" & vbTab & _
_
.Number & vbLf & vbLf & "Beschreibung:" & vbTab & .Description & vbLf, vbExclamation +  _
_
vbMsgBoxSetForeground, "VBA - Fehler in Modul - Modul1"
.Clear
End If
End With
On Error GoTo 0
Call BlattSchutz_Ein
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
End Sub
Sub Find_And_Copy(rngBereich As Range, strSuch_Name$, Destination As Range)
Dim rngCell As Range
Set rngCell = rngBereich.Find(What:=strSuch_Name, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rngCell Is Nothing Then rngCell.EntireRow.Copy Destination
Set rngCell = Nothing
End Sub