Hallo zusammen, 

leider bin ich etwas verzweifelt, da ich der folgende Code nicht das gewünschte Ergbenis liefert: 

Sub

    ' Filter in Spalte V nach "ZUBEHÖR" und kopiere alle Zeilen
    Range("A1").AutoFilter Field:=22, Criteria1:="=*Zube*"
    
    ' Finde die letzte Zeile und Spalte in der Tabelle
    Dim letzteZeile As Long
    Dim letzteSpalte As Long
    
    letzteZeile = Cells(Rows.Count, 1).End(xlUp).Row
    letzteSpalte = Cells(1, Columns.Count).End(xlToLeft).Column
    
    ' Kopiere den Bereich der gesamten Tabelle
    Range(Cells(2, 1), Cells(letzteZeile, letzteSpalte)).Copy
    
    ' Füge den kopierten Bereich ein
    Range(Cells(letzteZeile + 1, 1), Cells(letzteZeile + 1, letzteSpalte)).Select
    ActiveSheet.Paste
    
    'Definiere den Bereich der markierten Zellen
    Dim selectedCells As Range
    Set selectedCells = Selection
    
    'Definiere den Bereich der Zeilen oberhalb der markierten Zellen
    Dim rowsToDelete As Range
    Set rowsToDelete = Range("2:" & selectedCells.Row - 1)
    
    'Lösche die Zeilen oberhalb der markierten Zellen
    rowsToDelete.EntireRow.Delete Shift:=xlUp
    
    
    'Anzeigen aller Zeilen
    ActiveSheet.ShowAllData
 
End Sub


Was mit diesem Code erreicht werden soll: 

Es Soll in Spalte V nach allem mit "ZUBEH" gefiltert werden. Dann sollen alle Zeilen kopiert werden und anschließend in die aller erste freie Zeile (auch die nicht eingeblendeten Zeilen) eingefügt werden. Danach soll in diesem Gefiltertem Modus die erste obere Hälfte der Zeilen gelöscht werden. (Hintergrund ist der, dass die angefilterteten Zeilen unten in der Tabelle stehen sollen und nicht mehr Zwischen den Zeilen angegeben werden sollen) 

Vielleicht habt ihr auch einen anderen Vorschlag dieses Problem zu lösen? Leider werden mit dem o.g. Code auch einige Zeilen gelöscht (die wichtig sind), weil er die kopierte Tabelle direkt in die erste Zeile der angefilterte Tabelle (sichtbaren Zeilen) einfügt. 

Vielen Dank im Voraus. 
BG
Martin