nummers van plaats laten wisselen

Dim CelOldValue As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    CelOldValue = Target.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim FindString As String
    Dim Rng As Range
    
    If Target.Column = 2 Then
        Application.EnableEvents = False
        FindString = Target.Value
        If Trim(FindString) <> "" Then
            
            With Sheets("Blad1").Range("B:B")
                Set Rng = .Find(What:=FindString, _
                                After:=Range("B1"), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)

                If Rng.Address = Target.Address Then
                    Set Rng = .FindNext(Rng)
                End If
                                
                If Not Rng Is Nothing Then
                    Rng.Value = CelOldValue
                End If
            
            End With
        End If
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Long, y As Long
    Dim Cl As Range
    
    If Target.Column = 2 And Target.Value <> "" Then
        Application.EnableEvents = False
        y = Target.Value
        Application.Undo
        x = Target.Value
        Set Cl = Columns(2).Find(y, LookAt:=xlWhole)
        If Not Cl Is Nothing Then Cl.Value = x
        Target = y
        Application.EnableEvents = True
    End If
End Sub