Microsoft 365 Macro comparaison

[pierau666]

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

 

[Jacky67]

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

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

 

[pierau666]

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