Dim arrBegriffe()
Dim lngErste As Long
Dim lngZeile As Long
Dim blnLoeschen As Boolean
Dim lngLetzte As Long
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
Application.ScreenUpdating = False
With Worksheets("Tabelle2")
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
For lngZeile = 2 To lngLetzte
Select Case Cells(lngZeile, 18)
Case "Begriff1", "Begriff2", "Begriff3", "Begriff4"
Range(Cells(lngZeile, 1), Cells(lngZeile, 20)).Copy .Cells(lngErste, 1)
Cells(lngZeile, 1).ClearContents
lngErste = lngErste + 1
If blnLoeschen = False Then blnLoeschen = True
Case "Begriff5"
If Cells(lngZeile, 19) <> "" Then
Range(Cells(lngZeile, 1), Cells(lngZeile, 20)).Copy .Cells(lngErste, 1)
Cells(lngZeile, 1).ClearContents
End If
lngErste = lngErste + 1
If blnLoeschen = False Then blnLoeschen = True
End Select
Next lngZeile
End With
If blnLoeschen Then
lngLetzte = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range(Cells(1, 1), Cells(lngLetzte, 1)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlUp
End If
Application.ScreenUpdating = True
End Sub