Sub sonderbar()
Dim zeile As Long, found As Object, firstaddr As String
With ActiveSheet
For zeile = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If IsEmpty(.Cells(zeile, 1)) Then .Rows(zeile).Delete shift:=xlUp
Next zeile
.Range("A2") = "Apfel"
.Range("B2") = "Birne"
Do
Set found = .Cells.Find(what:="Hund", lookat:=xlWhole, LookIn:=xlValues)
If Not found Is Nothing Then .Columns(found.Column).Delete shift:=xlToLeft
Loop Until found Is Nothing
Do
Set found = .Cells.Find(what:="Katze", lookat:=xlWhole, LookIn:=xlValues)
If Not found Is Nothing Then .Columns(found.Column).Delete shift:=xlToLeft
Loop Until found Is Nothing
Do
Set found = .Cells.Find(what:="Maus", lookat:=xlWhole, LookIn:=xlValues)
If Not found Is Nothing Then .Columns(found.Column).Delete shift:=xlToLeft
Loop Until found Is Nothing
Do
Set found = .Cells.Find(what:="Frösch", lookat:=xlPart, LookIn:=xlValues)
If Not found Is Nothing Then .Range(found.Address) = Replace(.Range(found.Address).Text, "Frösch", "Frosch")
Loop Until found Is Nothing
End With
End Sub