Microsoft 365 Macro comparaison

pierau666

XLDnaute Nouveau
Bonjour,

Je souhaiterai creer une macro ayant pour but de comparer deux feuilles Excel. La première contient des données, la seconde contient le même type de données mais se met a jour toutes le semaines. J'aimerai comparer les deux feuilles afin de detecter les nouvelles données présentes dans la seconde feuille et absentes de la premiere feuille et les copier dans une troisieme feuille. J'ai essaye de coder un truc mais je ne parviens pas au resultat attendu. En effet, toutes les données de la seconde feuille sont copiées dans la troisieme alors que certaines sont deja presentes dans la premiere. Je joins mon fichier. La premiere feuille se nomme "Charges", la seconde feuille "ZQM77" et la troisieme "Feuil1".

Voici ce que j'ai codé:

Option Explicit

Dim fb As Worksheet, fp As Worksheet, test As Worksheet
Dim lnP&, lnB&, lgn&, flag&, ola&

Sub MettreAjour()

Set fb = Sheets("ZQM77")
Set fp = Sheets("Charges")
Set test = Sheets("Feuil1")

Application.ScreenUpdating = False

ola = 1

For lnB = 2 To fb.Range("E" & Rows.Count).End(xlUp).Row
flag = 0


For lnP = 2 To fp.Range("E" & Rows.Count).End(xlUp).Row

If fb.Range("E" & lnB) = fp.Range("E" & lnP) Then
lgn = lnP
flag = 1
Else: ola = ola + 1
Exit For
End If

Next lnP

If flag = 0 Then
lgn = fp.Range("E" & Rows.Count).End(xlUp)(2).Row
End If
fb.Range("A" & lnB & ":E" & lnB).Copy
test.Range("A" & ola).PasteSpecial xlPasteValues


Next lnB

Application.ScreenUpdating = True

End Sub

Si qqun pouvait me dire ou se trouve mon erreur, je lui en serais tres reconnaissant :)

Merci d'avance et bonne journée
 

Pièces jointes

  • Copie de QCBERM 2021 test 3.xlsm
    69.4 KB · Affichages: 6
Solution
Bonjour,

Je souhaiterai creer une macro ayant pour but de comparer deux feuilles Excel. La première contient des données, la seconde contient le même type de données mais se met a jour toutes le semaines. J'aimerai comparer les deux feuilles afin de detecter les nouvelles données présentes dans la seconde feuille et absentes de la premiere feuille et les copier dans une troisieme feuille. J'ai essaye de coder un truc mais je ne parviens pas au resultat attendu. En effet, toutes les données de la seconde feuille sont copiées dans la troisieme alors que certaines sont deja presentes dans la premiere. Je joins mon fichier. La premiere feuille se nomme "Charges", la seconde feuille...

Jacky67

XLDnaute Barbatruc
Bonjour,

Je souhaiterai creer une macro ayant pour but de comparer deux feuilles Excel. La première contient des données, la seconde contient le même type de données mais se met a jour toutes le semaines. J'aimerai comparer les deux feuilles afin de detecter les nouvelles données présentes dans la seconde feuille et absentes de la premiere feuille et les copier dans une troisieme feuille. J'ai essaye de coder un truc mais je ne parviens pas au resultat attendu. En effet, toutes les données de la seconde feuille sont copiées dans la troisieme alors que certaines sont deja presentes dans la premiere. Je joins mon fichier. La premiere feuille se nomme "Charges", la seconde feuille "ZQM77" et la troisieme "Feuil1".

Voici ce que j'ai codé:

Option Explicit

Dim fb As Worksheet, fp As Worksheet, test As Worksheet
Dim lnP&, lnB&, lgn&, flag&, ola&

Sub MettreAjour()

Set fb = Sheets("ZQM77")
Set fp = Sheets("Charges")
Set test = Sheets("Feuil1")

Application.ScreenUpdating = False

ola = 1

For lnB = 2 To fb.Range("E" & Rows.Count).End(xlUp).Row
flag = 0


For lnP = 2 To fp.Range("E" & Rows.Count).End(xlUp).Row

If fb.Range("E" & lnB) = fp.Range("E" & lnP) Then
lgn = lnP
flag = 1
Else: ola = ola + 1
Exit For
End If

Next lnP

If flag = 0 Then
lgn = fp.Range("E" & Rows.Count).End(xlUp)(2).Row
End If
fb.Range("A" & lnB & ":E" & lnB).Copy
test.Range("A" & ola).PasteSpecial xlPasteValues


Next lnB

Application.ScreenUpdating = True

End Sub

Si qqun pouvait me dire ou se trouve mon erreur, je lui en serais tres reconnaissant :)

Merci d'avance et bonne journée
Bonjour,
Seul le 100 est présent sur les deux feuilles
Essaye comme ceci
VB:
Sub Copier()
    Dim fb As Worksheet, fp As Worksheet, test As Worksheet
    Dim C As Range, plage, lig&
    Set fb = Sheets("ZQM77")
    Set fp = Sheets("Charges")
    Set test = Sheets("Feuil1")
    Application.ScreenUpdating = False
    test.Cells.Clear
    lig = 2
    Set plage = fp.Range("E2:E" & fp.Cells(fp.Rows.Count, "E").End(xlUp).Row)
    For Each C In fb.Range("E2:E" & fb.Cells(fb.Rows.Count, "E").End(xlUp).Row)
        If IsError(Application.Match(C, plage, 0)) Then
            fb.Rows(C.Row).Copy test.Cells(lig, 1)
            lig = lig + 1
        End If
    Next
End Sub
 
Dernière édition:

pierau666

XLDnaute Nouveau
Bonjour,

Merci beaucoup pour ta reponse, ca marche nickel. En effet, pour l'exemple je n'avaismis qu'une ligne en commun pour faire mes tests. Mais en fonction des semaines j'ai entre 50 à 100 nouvelles entrées.

En tous cas, c'est exactement ce que je voulais faire ! Je réitère mes remerciements !!!

Bonne journée
 

Statistiques des forums

Discussions
288 632
Messages
1 893 633
Membres
169 984
dernier inscrit
mdemrs
Haut Bas