Microsoft 365 Décaler case s'il y en a 2 similaires dans la même colonne

[quent632]

Bonjour,

Je suis débutant en VBA. J'aimerai savoir s'il existe une solution pour décaler une case s'il y en a 2 similaires dans la colonne.

J'ai essayé avec un boucle sur les colonnes.
Ma condition s'appuyant sur "ActiveCell", la boucle ne marche pas.

Sub miseajour()

Application.ScreenUpdating = False
   
Dim DernCol As Long
DernCol = Cells(1, Columns.Count).End(xlToLeft).Column

Dim CelSelec As Integer
CelSelec = Selection.Cells.Count
   
Dim colonne_en_cours As Long

With Sheets("Feuil1")
    For N = 1 To CelSelec
        For colonne_en_cours = 1 To DernCol
            If ActiveCell = .Cells(ActiveCell.Row + N, ActiveCell.Column) Then
                .Cells(ActiveCell.Row + N, ActiveCell.Column).Cut (.Cells(ActiveCell.Row + N, ActiveCell.Column + N))
            End If
        Next
    Next N
End With

Application.ScreenUpdating = True

End Sub

Sachant qu'il ne faut pas sélectionner la plage entière (ici "A3:E9") j'ai un peu de mal

Voici mon code lorsque j'ai ce cas particulier :

Sub miseajour()

Application.ScreenUpdating = False

Dim compteur As Integer
 
Dim DernCol As Long
DernCol = Cells(1, Columns.Count).End(xlToLeft).Column

Dim CelSelec As Integer
CelSelec = Selection.Cells.Count
 
Dim colonne_en_cours As Long

With Sheets("Feuil1")
    For N = 1 To CelSelec
        If ActiveCell = .Cells(ActiveCell.Row + N, ActiveCell.Column + N) Then
            .Cells(ActiveCell.Row + N, ActiveCell.Column + N).Cut (.Cells(ActiveCell.Row + N, ActiveCell.Column + N + 1))
        End If
    Next N
End With

Application.ScreenUpdating = True

End Sub

Après exécution du code on obtient :

Merci d'avance