Sub Löschen_irrelevanter_Daten()
Dim rngA As Range
Dim rngE As Range
Dim intCol As Integer
Dim intRowAnf As Integer
Dim intRowEnde As Integer
Set rngA = Cells.Find(What:="Arriving", _
After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
intCol = rngA.Column
intRowAnf = rngA.Row
Range(Cells(intRowAnf, intCol), Cells(intRowEnde, intCol)).EntireRow.Select
With Selection
On Error Resume Next
Rows("1:" & .Row - 1).Delete
Rows(.Row + .Rows.Count & ":" & Rows.Count).Delete
On Error GoTo 0
End With
End Sub