[b]Option Explicit

Sub Einfügen()
Dim Prüftext As Variant, Einfügtext As Variant
Dim i As Integer
Rem: Eingabefenster öffnen
Prüftext = InputBox("Bitte Text eingeben, nachdem eine Leerzeile eingefügt werden soll")
Rem: Auswertung ob eventuell kein Text eingetragen wurde oder Abbruchtaste betätigt wurde
Rem: Dann Prozedur beenden
If Prüftext = "" Or Prüftext = False Then Exit Sub
Rem: Schleife zum Finden des Prüftextes, Gesucht wird in Spalte A von Zeile 1
Rem: bis zur letzten gefüllten Zelle
For i = 1 To Range("A65536").End(xlUp).Row
Rem: Wenn der Wert in der durch die Schleife angesprochenen Zelle gleich dem Wert
Rem: der Variablen "Prüftext" dann...
If Cells(i, 1) = Prüftext Then
Rem: ...Eingebaefenster öffnen...
Einfügtext = InputBox("Bitte Text eingeben, der eingefügt werden soll")
Rem: Auswertung ob eventuell kein Text eingetragen wurde oder Abbruchtaste betätigt wurde
Rem: Dann Prozedur beenden
If Einfügtext = "" Or Einfügtext = False Then Exit Sub
Rem: ...Zeile über den gefunden Text einfügen...
Rows(i).Insert Shift:=xlDown
Rem: ...Text einfügen...
Cells(i, 1) = Einfügtext
Rem: Prozedur beenden
Exit Sub
End If
Next
End Sub[/b]