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

quent632

XLDnaute Nouveau
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.
1625053922028.png


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

VB:
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 :
1625054542017.png


Code:
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 :
1625054655094.png


Merci d'avance
 
Dernière édition:

Membres actuellement en ligne

Statistiques des forums

Discussions
293 048
Messages
1 928 125
Membres
183 854
dernier inscrit
issmaaiil54