AW - Zellen in Zieltabelle übertragen

Sub Daten_Übertragen()
'Bearbeitungsstand 09.11.2021
Dim oWsZ As Worksheet, i, j, n As Integer
Dim AC As Range, lzQuell As Long, lzZiel As Long
'setzt Verweis auf Zielblatt
Set oWsZ = Worksheets("AUS-Tabelle")
'setzt Verweis auf Quellblatt  (mit With!)
With Worksheets("AUS-EINGABEN")
'LastZell in Spalte A suchen  (reicht aus!)
lzQuell = .Cells(Rows.Count, 1).End(xlUp).Row
lzZiel = oWsZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
'Bildschirm abschalten
Application.ScreenUpdating = False
'Formeln berechnen auf Manuell setezen
Application.Calculation = xlCalculationManual
'Alle Buchungszeilen auf Eingabe prüfen
oWsZ.Unprotect
For j = 2 To lzQuell:  n = 0   'n löschen
'Spalte D-J jede Zelle Daten Prüfung
For i = 4 To 10
If IsError(.Cells(j, i)) Then n = n + 1
Next i
'Wenn Daten D-J Okay dann Blattschutz für Zielblatt aufheben und Werte kopieren
If n = 0 Then
.Cells(j, 1).Resize(1, 10).Copy  'Spalte A-J
oWsZ.Cells(lzZiel, 1).PasteSpecial xlPasteValues
.Cells(j, 1).Resize(1, 3).ClearContents  'löschen
Application.CutCopyMode = False
lzZiel = lzZiel + 1
End If
Next j
'Blattschutz für Zielblatt aufheben aktivieren
oWsZ.Protect
'Vorwärts löschen, verschiebt Datum + Nr. nach oben
For n = 2 To lzQuell
If .Cells(n, 1).Value = "" Then
For j = n + 1 To lzQuell
If .Cells(j, 1).Value  "" Then
.Cells(j, 1).Resize(1, 3).Copy
.Cells(n, 1).PasteSpecial xlPasteValues
.Cells(j, 1).Resize(1, 3) = Empty
Exit For
End If
Next j
End If
Next n
'Kopiermodus ausschalten
Application.CutCopyMode = False
'Formeln berechnen auf Automatic setezen
Application.Calculation = xlCalculationAutomatic
End With
End Sub