Sub suchen()
Dim Zelle As Range
Range("A5").Select
If Range("B1") = "" Then GoTo Errorhandler
For Each Zelle In Range("Namsuch").Cells
If Zelle = Range("B1") Then
Zelle.Select
'zur Positionierung am Bildschirm
If Zelle <> Range("A5") Then
ActiveWindow.SmallScroll Down:=17
End If
If Zelle = Range("A23") Then
ActiveWindow.SmallScroll Down:=1 '17+1=18Zeilen
End If
Zelle.Offset(0, 1).Select
For i = 1 To 17
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Next i
Exit Sub
End If
Next Zelle
Errorhandler:
MsgBox "Fehlerhafte Eingabe oder Name nicht vorhanden"
Range("b1").Activate
End Sub