Auf die "Schnelle" und "von Hinten durch die Brust ins Auge"

- mach ich mir in einer Ecke der Tabelle die Zahlen 1-6 in Zellen untereinander

- benenne diesen Zellbereich als  Name "Liste"

- in das Klassenmodul der Tabelle die Ereignisprozedur

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'nur Spalte B
If Intersect(Range("B:B"), Target) Is Nothing Then Exit Sub
'keine Massenänderung
If Target.Count > 1 Then Exit Sub

Dim c As Range
Dim Arr() As Variant
Dim va As Integer
Dim Flag As Integer

Application.EnableEvents = False

   'Vorgabe einlesen
   Arr = Range("Liste").Value
   For va = LBound(Arr, 1) To UBound(Arr, 1)
      Select Case Target.Value
         'Zelle wurde gelöscht
         Case ""
            If Arr(va, 1) = Target.Value Then
               Arr(va, 1) = va
               Flag = 0
            End If
         'Zelle hat (neuen) Wert
         Case Else
            If Arr(va, 1) = Target.Value Then
               Arr(va, 1) = ""
               Flag = 1
            End If
      End Select
   Next va
   
   'zurückschreiben
   Range("Liste").Value = Arr
   
   'jetzt Gegenprobe
   Select Case Flag
      Case 1
      For va = LBound(Arr, 1) To UBound(Arr, 1)
         If Arr(va, 1) = "" Then
            Set c = Range("B:B").SpecialCells(xlCellTypeAllValidation).Find(va)
            If Not c Is Nothing Then
            Else
               Arr(va, 1) = va
            End If
         End If
      Next va
      Case 0
      For va = LBound(Arr, 1) To UBound(Arr, 1)
         If Arr(va, 1) <> "" Then
            Set c = Range("B:B").SpecialCells(xlCellTypeAllValidation).Find(va)
            If Not c Is Nothing Then
               Arr(va, 1) = ""
            Else
            End If
         End If
      Next va
   End Select
   
   'nochmals zurückschreiben
   Range("Liste").Value = Arr
   
Application.EnableEvents = True

End Sub