VBA correspondance de données
A
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 SubPar avance, merci de votre aide et bonne journée à tous
A
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