Comparer plages de cellules + cuper/coller

Bonjour,

j'ai le code suivant qui me permet de comparer et matcher 2 cellules avec 2 autres sur une feuille donnée.

Je voudrais l'adapter afin que je puisse comparer 4 cellules avec 4 autres

Exemple: j'ai un fichier avec 2 feuilles. Je voudrais comparer toutes les lignes de la feuille 2 (la plage de cellules B à E) aux plages B à E de la feuille 1, "couper" toutes les lignes qui sont identiques et les coller à côté de la plage correspondante sur la feuille 1

Merci d'avance pour votre aide

Sub SommeSi()

Application.ScreenUpdating = False

Dim derLig As Long, Dico As Object, mm As Variant, nn As Variant, mySplit As Variant

Set Dico = CreateObject("scripting.dictionary")

derLig = Range("B" & Rows.Count).End(xlUp).Row

For a = 2 To derLig

zz = Cells(a, 1) & "§" & Cells(a, 2)

If Not Dico.Exists(zz) Then

Dico(zz) = Cells(a, 3).Value

Else

Dico(zz) = Dico(zz) + Cells(a, 3).Value

End If

Next a

mm = Dico.Keys

nn = Dico.Items

derLig = Range("F" & Rows.Count).End(xlUp).Row

For b = 2 To derLig

For c = 0 To Dico.Count - 1

mySplit = Split(mm(c), "§")

If Cells(b, 6) = mySplit(0) And Cells(b, 7) = mySplit(1) Then

Cells(b, 9) = nn(c)

Exit For

End If

Next c

Next b

Application.ScreenUpdating = True

End Sub

9classeur1-1.zip (11.99 Ko)

Je reconnais mon code dans ton message... Décidément !

Solution à tester...

et la prochaine fois, ça te coutera une mousse !

26d3822.zip (21.27 Ko)

héhé comme quoi...ça sert vraiment ce que vous faites et ça s'oublie pas mais au contraire on le garde précieusement

Merci bcp et pas de soucis pour la mousse

j'apprecie bcp ton aide!

Bonjour Game Over,

j'ai encore une petite question. Je viens de tester la macro sur un fichier plus lourd ( 10000 lignes). Les premières 6000 lignes tout va bien et ensuite la macro indique avoir terminé mais il reste des lignes identiques dans les deux onglets qui ne sont pas coupées/collées. Ensuite j'ai fait le test avec les lignes non copiées dans un autre fichier (j'en ai pris une 20aine) et ça marche. Donc les lignes sont identiques. Ensuite j'ai pris a peu près 300 lignes et ça marche jusqu'à la ligne 190 par exemple et la suite il veut plus... même si je relance la macro. Je trouve ça hyyyyper bizarre. Une macro soit elle marche soit elle marche pas... Pourquoi elle ne veut pas traiter la totalité mais en même temps elle traite les mêmes lignes si elles sont dans plus petites quantités ?

Merci et excuse-moi de t’embêter encore

ben comme ça, c'est difficile à dire...

j'ai besoin de voir le fichier...

t'as mon adresse mail sous mon avatar

la version corrigée

Option Base 1
Sub try()

Application.ScreenUpdating = False
Dim derlig1 As Long, derLig2 As Long
Dim aa As Variant, bb As Variant

With Sheets("Feuil2")
    derLig2 = .Range("A" & Rows.Count).End(xlUp).Row
     bb = .Range(.Range("B1"), .Cells(derLig2, "F"))
End With

With Sheets("Feuil1")
    .Range("G:K").ClearContents
    derlig1 = .Range("A" & Rows.Count).End(xlUp).Row
    aa = .Range(.Range("B2"), .Cells(derlig1, "F"))

    For i = LBound(aa) To UBound(aa)
        xx = aa(i, 1) & aa(i, 2) & aa(i, 3) & aa(i, 4)
        For j = LBound(bb) To UBound(bb)
            yy = bb(j, 1) & bb(j, 2) & bb(j, 3) & bb(j, 4)
            If xx = yy Then
                .Cells(i + 1, 7).Resize(1, 5) = Application.Index(bb, j)
                Sheets("Feuil2").Range("B" & j).Resize(1, 5).Clear
                Exit For
            End If
        Next j
    Next i
    .Columns("K:K").NumberFormat = "0%"
End With

End Sub

Un très très grand merci à Game Over !

Heureusement qu'il y a des gens comme vous !

Rechercher des sujets similaires à "comparer plages cuper coller"