Déplacer une cellule lorsque des valeurs sont identiques dans une colonne

Bonjour

Je cherche à déplacer une cellule de la colonne V sur la première cellule non vide de la ligne précédente lorsque dans la colonne A les valeurs sont identiques.
J'ai écrit cette macro qui fonctionne sauf que j'ai un décalage lorsqu'il y a plus de 2 doublons en colonne A .
Si un pro des macros peut me rectifier le code , je l'en remercie d'avance .
Bonne journée

Bonjour,

Voici une proposition en partant d'un tableau structuré (nommé Donnees) et en restituant les données dans une feuille nommée test :

Sub deplace()

Set dico = CreateObject("Scripting.dictionary")

With Range("Donnees")
    maxdim = .Columns.Count
    ReDim t(1 To .Rows.Count, 1 To maxdim)
    For i = 1 To .Rows.Count
        If Not dico.exists(.Cells(i, 1).Value) Then
            n = n + 1
            dico(.Cells(i, 1).Value) = Array(n, .Columns.Count)
            For k = 1 To .Columns.Count
                t(n, k) = .Cells(i, k).Value
            Next k
        Else
            lig = dico.Item(.Cells(i, 1).Value)(0)
            nvcol = dico.Item(.Cells(i, 1).Value)(1) + 1
            dico(.Cells(i, 1).Value) = Array(lig, nvcol)
            maxdim = Application.Max(maxdim, nvcol)
            ReDim Preserve t(1 To UBound(t), 1 To maxdim)
            t(lig, nvcol) = .Cells(i, 22).Value
        End If
    Next i
End With

With Sheets("test")
    .Rows(1).Resize(, maxdim).Value = Range("Donnees").Rows(0).Value
    .Cells(2, 1).Resize(n, UBound(t, 2)) = t
End With

End Sub

Cdlt,

Bonjour le fil, bonjour le forum,

Chaque fois que je me lance dans ce genre de problème je sais que je fabrique toujours une usine a gaz et surtout, quand je vois les autres solutions, en l'occurrence celle de 3GB, je pleure...

Mais bon je t'envoie quand même ma proposition...

Sub deplace()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim PAE As Range 'déclare la variable PAE (Plage À Effacer)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim NL As Byte 'déclare la variable NL (Nombre de Lignes)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim PCV As Integer 'déclare la variable PCV (Première Colonne Vide)

Set O = Worksheets("Feuil1") 'définit l'onglet O
Set PAE = O.Range("A1") 'initialise la plage à effacer PAE
TV = O.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    NL = 0 'réinitialise le combre de ligne NL
    For j = I + 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant la ligne I+1)
        If I <> j And TV(I, 1) = TV(j, 1) Then 'condition 1 : si I est différente de J et si la donnée ligne I colonne 1 de TV est égale à la donnée ligne J colonne 1 de TV
            NL = NL + 1 'incrémente le nombre de lignes NL
            If NL = 1 Then 'condition 2 : si NL vaut un
                K = K + 1 'incrémente K
                ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes TL (2 lignes, K colonnes)
                TL(1, K) = I 'récupere le numéro de ligne I de la première valeur du doublon dans la ligne 1 de TL
            End If 'fin de la condition 2
            I = I + 1 'incrémente I
        Else 'sinon (condition 1)
            If K > 0 Then TL(2, K) = NL 'si K est supérieure a zéro récupère le nombre de ligne NL dans la ligne 2 de TL
            Exit For 'sort de la boucle 2
        End If 'fin de la condition 1
    Next j 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
'le tableau TL contient, chaque fois qu'il y a des doublons, la ligne de la première valeur du doublon ert le nombre de fois que cette valeur est répétée
For I = UBound(TL, 2) To 1 Step -1 'boucle 1 : inversée dur toutes les colonnes de TL par pas de -1
    For j = 1 To TL(2, I) 'boucle 2 : sur le nombre de fois que le doublon est répété
        PCV = O.Cells(TL(1, I), Application.Columns.Count).End(xlToLeft).Column + 1 'définit la première colonne vide PCV de la ligne du premier doublon
        O.Cells(TL(1, I), PCV).Value = TV(TL(1, I) + j, 22) 'renvoie dans la ligne du premier doublon colonne PCV, la valeur de la ligne décalé de J
        Set PAE = IIf(PAE.Cells.Count = 1, O.Rows(TL(1, I) + j), Application.Union(PAE, O.Rows(TL(1, I) + j))) 'définit la plage à effacer PAE
    Next j 'prochaine fois de la boucle 2
Next I 'procheine colonne de TL
PAE.Delete 'supprime la plage à effacer
O.Activate 'active l'onglet O (au cas où...)
With O.Range("A1") 'prend en compte la cellule A1 de l'onglet O
    .Copy 'copie
    .CurrentRegion.PasteSpecial (xlPasteFormats) 'colle les format
    .Select 'sélectionne
End With 'fin de la prise en compte de la cellule A1 de l'onglet O
Application.CutCopyMode = False 'supprime le clignotement lié au copir/coller
End Sub

Top , merci à vous deux .

Bonne journée