VBA correspondance de données

Bonjour à tous,

Je vais encore avoir recours à vos lumières

J'ai créer un fichier pour un besoin pro. Ce fichier doit comparer 2 listes et faire resortir les dossiers qui sont unique de l'onglet Endo (et copié dans l'onglet "Dispatch")

La macro copie bien les données mais autant de fois qu'il y a de ligne dans l'onglet "Quai" au lieu d'une seul fois

Voici le code et un exemple du fichier avec le résultat actuelle de la macro et un onglet avec le résultat rechercher

Sub Compilation()

Dim DATA As Worksheet
Dim OS As Worksheet
Dim OS1 As Worksheet
Dim Plage1 As Range
Dim nb As Integer
Dim Plage2 As Range
Dim nb2 As Integer
Dim l As Integer
Dim m As Integer

Set OS = Worksheets("Endo")
Set Plage1 = OS.Range("A1").CurrentRegion
nb = Plage1.Rows.Count

Set OS1 = Worksheets("Quai")
Set Plage2 = OS1.Range("A1").CurrentRegion
nb2 = Plage2.Rows.Count

Set DATA = Worksheets("Dispatch")

k = 2

For l = 2 To nb
For m = 2 To nb2

If OS.Range("A" & l) <> OS1.Range("A" & m) Then

        OS.Rows(l).Copy
        DATA.Cells(k, 1).PasteSpecial xlPasteValues
        k = k + 1

End If

    Next m
    Next l

End Sub

Par avance, merci de votre aide et bonne journée à tous

5dispatch.xlsm (22.35 Ko)

Finalement, j'ai réussi avec 2 boucles distinctes

Si cela peut intéresser du monde, voici le code

Sub Compilation()

Dim DATA As Worksheet
Dim OS As Worksheet
Dim OS1 As Worksheet
Dim Plage1 As Range
Dim nb As Integer
Dim Plage2 As Range
Dim nb2 As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer

Set OS = Worksheets("Colis manquants et endommagés")
Set Plage1 = OS.Range("A1").CurrentRegion
nb = Plage1.Rows.Count

Set OS1 = Worksheets("Recherche à quai")
Set Plage2 = OS1.Range("A1").CurrentRegion
nb2 = Plage2.Rows.Count

Set DATA = Worksheets("Dispatch")

OS.Activate
For g = 2 To nb
    Cells(g, 25) = Cells(g, 6) & Cells(g, 7) & Cells(g, 16)
Next g

OS1.Activate
For f = 2 To nb2
    Cells(f, 23) = Cells(f, 6) & Cells(f, 7) & Cells(f, 14)
Next f

k = 2
i = 1

For l = 2 To nb
For m = 2 To nb2

If OS.Range("Y" & l) <> OS1.Range("W" & m) Then

        OS.Range("Z" & l).Value = i
        i = i + 1
End If

    Next m
    i = 1
    Next l

k = 2

For n = 2 To nb

    If OS.Range("Z" & n).Value = nb2 - 1 Then

        OS.Rows(n).Copy
        DATA.Cells(k, 1).PasteSpecial xlPasteValues
        k = k + 1

        End If

        Next n

End Sub
Rechercher des sujets similaires à "vba correspondance donnees"