Comparer deux listes, copier et garder valeurs

Bonjour à tous,

J'ai deux listes, une modifiée manuellement en ajoutant des commentaires et une mise en forme ("Plan"). L'autre est une liste "brute" sans commentaires qui est importée d'une BDD ("Buffer").

L'idée est de mettre à jour la liste Plan en copiant la liste Buffer qui est régulièrement modifiée (dates) en gardant les commentaires dans les colonnes A,B,K,L,M. Chaque n°ordre est unique.

Je pensais faire comme ça :

Import de la liste à jour dans "buffer"

Lancer macro MiseEnPage

Est-ce que vous pensez que c'est faisable ?

Merci d'avance

21planning.xlsm (21.85 Ko)

Bonjour

Un essai à tester.

Je ne m'y suis pas pris comme tu l'expliques.

Je passe toutes les lignes de la feuille Buffer et je regarde dans la feuille Plan s'il existe en colonne D le même numéro d'ordre.

Si on trouve ce numéro, on copie dans Buffer la ligne de la colonne A à la colonne J et on copie ça sur la ligne de même numéro dans la feuille Plan.

Si dans la feuille Plan il n'y a pas ce numéro, c'est qu'il est nouveau. On colle e alors la plage copiée à la suite.

Cela te convient-il ?

Bye !

78planning-v1.xlsm (31.92 Ko)

Salut merci de ta réponse rapide.

"Je passe toutes les lignes de la feuille Buffer et je regarde dans la feuille Plan s'il existe en colonne D le même numéro d'ordre."

Pour cette partie cela me convient.

Après se serai plutôt :

Si on trouve ce numéro, on copie les colonnes A:B et K:M de la feuille Plan pour les coller dans Buffer.

Après on supprime toutes les données de la feuille Plan A6:M et on les remplace par les données de la feuille Buffer.

Merci de ton aide

ça devrait être quelque chose de cette forme ça a l'air de marcher

Sub MettreAjour()

    Set fb = Sheets("Buffer")
    Set fp = Sheets("Plan")

    For lnB = 6 To fb.Range("D" & Rows.Count).End(xlUp).Row

        For lnP = 6 To fp.Range("D" & Rows.Count).End(xlUp).Row
            If fb.Range("D" & lnB) = fp.Range("D" & lnP) Then
                lgn = lnP
                fp.Range("A" & lnP & ":B" & lnP).Copy
                fb.Range("A" & lnB & ":B" & lnB).PasteSpecial
                fp.Range("K" & lnP & ":M" & lnP).Copy
                fb.Range("K" & lnB & ":M" & lnB).PasteSpecial

                'fp.Range("A6:M").ClearContents
                'fb.Range("A6:M").Copy fp.Range("A6")
            End If
        Next lnP
     Next lnB
End Sub

Alors, si ça marche comme tu veux, pourquoi chercher plus loin ?

Bye !

Du coup ça me donne ça c'est possible de l'optimiser (réduire le nb de lignes)?

Sub MettreAjour()

    Set fb = Sheets("Buffer")
    Set fp = Sheets("Plan")
    Application.ScreenUpdating = False

    For lnB = 6 To fb.Range("D" & Rows.Count).End(xlUp).Row

        For lnP = 6 To fp.Range("D" & Rows.Count).End(xlUp).Row
            If fb.Range("D" & lnB) = fp.Range("D" & lnP) Then
                lgn = lnP
                fp.Range("A" & lnP & ":B" & lnP).Copy
                fb.Range("A" & lnB & ":B" & lnB).PasteSpecial
                fp.Range("K" & lnP & ":M" & lnP).Copy
                fb.Range("K" & lnB & ":M" & lnB).PasteSpecial
            End If
        Next lnP
     Next lnB

    With fp
    fp.Activate
    DerL = Range("D" & Rows.Count).End(xlUp).Row
    DerC = Cells(5, Cells.Columns.Count).End(xlToLeft).Column

    Set Plage = Range(Cells(6, 1), Cells(DerL, DerC))
        Plage.Select
        Selection.EntireRow.Delete
        Range("A1").Select
    End With

    With fb
    fb.Activate
    DerL = Range("D" & Rows.Count).End(xlUp).Row
    DerC = Cells(5, Cells.Columns.Count).End(xlToLeft).Column

    Set Plage = Range(Cells(6, 1), Cells(DerL, DerC))
        Plage.Select
        Selection.Copy fp.Range("A6")
        Selection.EntireRow.Delete
        fp.Activate

    End With

End Sub

Non, désolé, je ne vois pas.

Bye !

D'accord merci de ton aide !

Rechercher des sujets similaires à "comparer deux listes copier garder valeurs"