Kopieren von Zeilen aus einer Tabelle in eine andere per Macro

Sub ArchivierungAlteZeilen()
 ->ggf. Anpassen
  Const c_Z_ErsteWerteZeile = 2-> erste Zeile mit Statuseintrag
  Const c_Blattname_Arbeitsblatt = Tabelle1
  Const c_Blattname_Archiv = Archiv
  
  Const c_SP_Status = 3       'Spaltennummer Status
  Const c_SP_Datum = 10       'Spaltennummer Datum
  Const c_Status_Grenze = 10 ->Status >= 10 prüfen
  Const c_Datum_minAlter = 30->30 Tage

  Dim wb As Workbook, b_changed As Boolean
  Dim wsq As Worksheet, l_qZeileMax As Long, q As Long
  Dim wsz As Worksheet, l_zZeileMax As Long
  Dim d_date_heute As Date, d_date As Date
  
  b_changed = False
  Set wb = ActiveWorkbook
  
  On Error Resume Next->bei Fehler mit nächster Zeile fortfahren
  
 ->Quell-Blatt
  Set wsq = Worksheets(c_Blattname_Arbeitsblatt)
  If Err.Number <> 0 Then
    Err.Clear
    MsgBox (Blatt-> & c_Blattname_Arbeitsblatt &-> konnte nicht geöffnet werden.)
    GoTo Aufraeumen
  End If
 ->Anzahl benutzter Zeilen feststellen
  l_qZeileMax = wsq.Cells(wsq.Rows.Count, c_SP_Status).End(xlUp).Row
  
 ->Ziel-Blatt
  Set wsz = Worksheets(c_Blattname_Archiv)
  If Err.Number <> 0 Then
    Err.Clear
    MsgBox (Blatt-> & c_Blattname_Archiv &-> konnte nicht geöffnet werden.)
    GoTo Aufraeumen
  End If
 ->Anzahl benutzter Zeilen feststellen
  l_zZeileMax = wsz.Cells(wsz.Rows.Count, c_SP_Status).End(xlUp).Row
  
  On Error GoTo 0->Fehlerbehandlung abschalten
  
  d_date_heute = Now()
  
 ->Alle relevanten Zeile des Quellblattes finden
  q = c_Z_ErsteWerteZeile - 1
  Do While q < l_qZeileMax
    q = q + 1
   ->Statusgrenze erreicht ?
    If wsq.Cells(q, c_SP_Status).Value >= c_Status_Grenze Then
     ->Datum nicht leer ?
      If wsq.Cells(q, c_SP_Status).Value <>  Then
        d_date = wsq.Cells(q, c_SP_Datum).Value
       ->Datum älter als 30 Tage ?
        d_date = d_date + c_Datum_minAlter
        If d_date < d_date_heute Then
         ->Zeile ausschneiden und im Archi anfügen
          l_zZeileMax = l_zZeileMax + 1
          If l_zZeileMax > 65534 Then
            MsgBox (Das Blatt  & c_Blattname_Archiv &  ist voll!)
            GoTo Aufraeumen
          End If
          wsq.Rows(q).Copy Destination:=wsz.Rows(l_zZeileMax)
          wsq.Rows(q).Delete
          q = q - 1: l_qZeileMax = l_qZeileMax - 1
          b_changed = True
        End If
      End If
    End If
  Loop
  
Aufraeumen:
 ->Mappe speichern, wenn etwas ins Archiv verschoben wurde
  If b_changed Then
    wb.Save
  End If
  
  Set wb = Nothing: Set wsq = Nothing: Set wsz = Nothing
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Call ArchivierungAlteZeilen
End Sub