Guten Tag zusammen,

ich hab hier ein Problem, dass mich wahnsinnig macht. Meine VBA Kenntnisse sind nicht gerade die besten, würde sogar sagen ich bin Anfänger. Zu meinem Problem:
 

Ich habe eine Liste mit zwei Registerkarten "Aktueller Bestand" und "Archiv"

Ich möchte, dass wenn die Spalte 18 mit "Ja" deklariert wird oder die Spalte 25 mit "Ja" deklariert wird, dass die ganze Zeile ausgeschnitten und in die nächste freie Zeile (Zeile 7) eingefügt wird. Dabei ist es wichtig, dass die Formeln nicht mitgenommen werden, d.h. ich möchte nur die Werte haben, die ich aus "Aktueller Bestand" kopiere. So nun möchte ich, dass die leere Zeile, die sich ja jetzt in der Registerkarte "Aktueller Bestand" gebildet hat, gelöscht wird.

Hier der bisherige Code mit all den Erklärungen, die ich mir zusammengereimt habe. Hoffe mir wann jemand weiterhelfen, bin am verzweifeln :( VIELEN DANK FÜR JEDE HILFE

Sub Archivieren()
' Die umgerüsteten oder an Sperrlager Rot gelieferten Motoren werden aus "Aktueller Bestand" an "Archiv" übersendet.
' Die Formeln werden dabei NICHT übertragen, sondern nur die Werte

Dim Zeile As Long
Dim Anzahl1 As Long
Dim Anzahl2 As Long
Dim sZeile As String

' Deklaration der einzelnen Variablen

Sheets("Aktueller Bestand").Activate ' Auswahl der Registerkarte "Aktueller Bestand"

Anzahl1 = ActiveSheet.UsedRange.Rows.Count ' Excel zählt in der Registerkarte "Aktueller Bestand" alle Zeilen, die in der Spalte FZ etwas drinstehen haben ab Anfang
i=1
For Zeile = 1 To Anzahl1
    Sheets("Aktueller Bestand").Activate ' Für die Zeilen 1 bis zur letzten Zeile in der Registerkarte "Aktueller Bestand"_
    If Cells(Zeile, 18).Value = "Ja" Or Cells(Zeile, 25).Value = "Ja" Then ' Wenn die Spalte "Zur Umrüstung?" ODER "Zum Sperrlager Rot?" mit Ja gekennzeichnet sind
    sZeile = LTrim(Str(Zeile))
    Rows(sZeile & ":" & sZeile).Select
    Selection.Copy ' Die ausgewählten Zeilen werden nun kopiert und in den Zwischenspeicher gespeichert
    Sheets("Archiv").Select ' Die Registerkarte "Archiv" wird ausgewählt
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False ' Nur die Werte und nicht die Formeln werden übertragen
        

Sheets("Aktueller Bestand").Select ' Nun wird die Registerkarte ("Aktueller Bestand") gewählt.
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 ' Nun werden sämtliche Zeilen begutachtet
If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete ' Wenn nun eine Zeile keinen Wert hat, dann soll sie gelöscht werden
Next


End If

End Sub