Makro sortiert nicht wie gewünscht

Sub CompleteTaskWithSortAndRemoveDuplicates()

    Dim ws As Worksheet

    Dim row As Long, col As Long

    Dim lastCol As Long

    Dim searchTerms As Variant

    Dim cellValue As String

    Dim sortRange As Range

    

    ' Arbeitsblatt "Update" definieren

    Set ws = ThisWorkbook.Sheets("Update")

    

    ' Suchbegriffe definieren (korrekt mit "prothetisch")

    searchTerms = Array("4 Begriffe")

    

    ' 1. Durchsuchen jeder 4. Zeile ab Zeile 8 nach den Suchbegriffen und Löschen der Zellen

    For row = 8 To 1000 Step 4

        For col = 1 To 300 ' Wir durchlaufen bis zur Spalte 300 (KN)

            cellValue = ws.Cells(row, col).Value

            ' Überprüfen, ob einer der Suchbegriffe enthalten ist

            Dim term As Variant

            For Each term In searchTerms

                If InStr(1, cellValue, term, vbTextCompare) > 0 Then

                    ' Inhalt der Zelle löschen

                    ws.Cells(row, col).ClearContents

                    ' Inhalt der 3 Zellen oberhalb löschen (wenn sie existieren)

                    If row - 1 >= 1 Then ws.Cells(row - 1, col).ClearContents

                    If row - 2 >= 1 Then ws.Cells(row - 2, col).ClearContents

                    If row - 3 >= 1 Then ws.Cells(row - 3, col).ClearContents

                    Exit For ' Aus der Begriffsschleife, da Fund

                End If

            Next term

        Next col

    Next row

    

    ' 2. Löschen der Zeilen, außer jeder 4. ab Zeile 3, **und Zeile 4 wird nicht gelöscht**

    For row = 1000 To 1 Step -1

        If row > 4 And row >= 3 And (row - 3) Mod 4 > 0 Then

            ws.Rows(row).Delete

        End If

    Next row

    

    ' 3. Löschen der Spalten von A bis KN (Spalte 1 bis 300), wenn Zeile 5 leer ist

    For col = 300 To 1 Step -1

        If ws.Cells(5, col).Value = "" Then

            ' Spalte löschen

            ws.Columns(col).Delete

        End If

    Next col

    

    ' 4. Bestimme die neue letzte Spalte anhand von Zeile 1 (nach dem Löschen)

    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    MsgBox "Die neue letzte Spalte ist: " & lastCol

    

    ' 5. Sortieren des Bereichs 5:1000 in jeder Spalte alphabetisch

    For col = 1 To lastCol

        ' Den Bereich für die Sortierung explizit festlegen (Zeilen 5 bis 1000 in der aktuellen Spalte)

        Set sortRange = ws.Range(ws.Cells(5, col), ws.Cells(1000, col))

        

        ' Sortiere den Bereich alphabetisch

        sortRange.Sort Key1:=ws.Cells(5, col), Order1:=xlAscending, Header:=xlNo

    Next col

    

    ' 6. Duplikate in jeder Spalte (Bereich 5:1000) entfernen

    For col = 1 To lastCol

        ' Bereich 5:1000 in der aktuellen Spalte für Duplikate

        Set sortRange = ws.Range(ws.Cells(5, col), ws.Cells(1000, col))

        

        ' Duplikate entfernen

        sortRange.RemoveDuplicates Columns:=1, Header:=xlNo

    Next col

    

    ' 7. Löschen der Zeilen 4, 2 und 1 (in dieser Reihenfolge, damit Zeile 4 zuerst gelöscht wird)

    ws.Rows(4).Delete

    ws.Rows(2).Delete

    ws.Rows(1).Delete

    

    MsgBox "Die Duplikate wurden entfernt und Zeilen 1, 2 und 4 gelöscht."

End Sub