Nun ich meine, wenn sich schon jemand als absolut VBA unkundig vorstellt, dann wird der

Hilfesuchende wohl kaum die Praxis für einen halbwegs funktionierenden Algorithmus, einen

Programmlaufplan ausweisen. Womit wohlmeinende Hinweise auf diverse Excel Ereignisse

oder Methoden, zumal im Web zusammengekratzt ersteres sicher nicht ersetzen.

Sei es darum, wenn schon denn schon. Wobei mein Vorschlag exakt auf den Tabellenaufbau

des Bildes aufbaut.

Nächste Voraussetzung, der Fragesteller kann zumindest die Klassen-Code-Module der Tabellen

durch Doppelklick in den Tabellenbaum öffnen, bzw. ein einfaches Codemodul anlegen.

Gegenständlich bekommt jede Tabellenklasse diesen, den gleichen Code

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Count = 1 And Target.Row > 1 Then _
      If Not Intersect(Columns(cCOLS), Target) Is Nothing Then DoIt Target
End Sub

und dazu in ein einfaches Codemodul

Option Explicit

Public Const cCOLS As String = "F:G"
'Zelle F1 bzw. G1 sind die bezogenen Tabellennamen

Sub DoIt(myRng As Range)
Dim strName As String

'sinnlos
If Application.CountA(myRng.EntireRow) <= 1 Then Exit Sub

On Error GoTo errorhandler
Application.EnableEvents = False

   strName = ActiveSheet.Columns(myRng.Column).Cells(1).Value
   
   Select Case myRng.Parent.Name
      Case "Aktiv"
         'eine Richtung - nur markieren
         If Not IsEmpty(myRng) Then
            myRng.EntireRow.Copy _
            Sheets(strName).Cells(Rows.Count, 1).End(xlUp).Offset(1)
            myRng.EntireRow.Delete
         End If
      
      Case "Erledigt"
         If strName = ActiveSheet.Name Then
            If Not IsEmpty(myRng) Then
               'nicht gelöscht
            Else
               Columns(cCOLS).Rows(myRng.Row).ClearContents
               myRng.EntireRow.Copy _
               Sheets("Aktiv").Cells(Rows.Count, 1).End(xlUp).Offset(1)
               myRng.EntireRow.Delete
            End If
         Else
            If Not IsEmpty(myRng) Then
               myRng.Offset(, -1).ClearContents
               myRng.EntireRow.Copy _
               Sheets(strName).Cells(Rows.Count, 1).End(xlUp).Offset(1)
               myRng.EntireRow.Delete
            Else
               'nicht markiert
            End If
         End If
         
      Case "Archiv"
         If strName = ActiveSheet.Name Then
            If Not IsEmpty(myRng) Then
               'nicht gelöscht
            Else
               Columns(cCOLS).Rows(myRng.Row).ClearContents
               myRng.EntireRow.Copy _
               Sheets("Aktiv").Cells(Rows.Count, 1).End(xlUp).Offset(1)
               myRng.EntireRow.Delete
            End If
         Else
            If Not IsEmpty(myRng) Then
               myRng.Offset(, 1).ClearContents
               myRng.EntireRow.Copy _
               Sheets(strName).Cells(Rows.Count, 1).End(xlUp).Offset(1)
               myRng.EntireRow.Delete
            Else
               'nicht markiert
            End If
         End If
         
   End Select
   
On Error GoTo 0
errorhandler:
Application.EnableEvents = True
End Sub