Comparaison de colonne sans perdre les données
Bonjour,
Après plusieurs recherche sur le forum infructueuses, je me permets de poster ce message en vous demandant de l'aide
Voila, j'ai 2 fichiers a comparer mais tout en gardant les lignes dans l'ordre.
Je m'explique.
- J'ai un fichier qui se nomme ARTICLE qui doit rester ABSOLUMENT dans le même ordre.
- Ensuite le fichier AUTRE, qui va me servir de comparaison pour récupérer la colonne tarif B qui correspondra au même produit du fichier ARTICLE grâce à une comparaison de GENCOD.
Je vous ai mi un exemple pour mieux comprendre.
Sachant que certains articles n'auront pas de doublon.
J'en ai récupérer quelque un manuellement ( ctrl+F )
En vous remerciant d'avance.
Julien.
PS = Le fichier AUTRE ce trouve dans le 2ème message car trop gros pour mettre les deux d'un seul coup.
Le fichier ARTICLE est en .zip car trop gros aussi.
Fichier AUTRE en pièce jointe.
Sub Comparaison()
'**ouverture fichiers annexes
On Error Resume Next
Workbooks.Open ThisWorkbook.Path & "\AUTRE.xlsm"
Workbooks.Open ThisWorkbook.Path & "\ARTICLE.xlsm"
'raccourci Fichiers
wsar = Workbooks("ARTICLE").Sheets(1)
wsau = Workbooks("AUTRE").Sheets(1)
wsr = Workbooks("Résultats article-autre").Sheets(1)
'**Lignemax(derniere ligne du tableau)
Lignemax1 = Workbooks("ARTICLE").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox Lignemax1
Lignemax2 = Workbooks("AUTRE").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox Lignemax2
Lignemax3 = Workbooks("Résultats article-autre").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
'MsgBox Lignemax3
'**Comparaison
For i = 2 To Lignemax1 'nombre de ligne fichier Article
For j = 2 To Lignemax2 ''nombre de ligne fichier Autre
If wsar.Cells(i, "F").Text = wsau.Cells(j, "A").Text Then 'si Gencod wsar=Gencod wsau
wsar.Cells(i, "A").Copy wsr.Range("A" & Lignemax3) 'cellule Genre wsar
'wsar.Cells(i, "D").Copy wsr.Range("B" & Lignemax3) 'cellule N° wsar
'wsar.Cells(i, "F").Copy wsr.Range("C" & Lignemax3) 'cellule Gencod wsar
'wsar.Cells(i, "H").Copy wsr.Range("D" & Lignemax3) 'cellule N° ean wsar
'wsar.Cells(i, "I").Copy wsr.Range("E" & Lignemax3) 'cellule Nom wsar
'wsar.Cells(i, "J").Copy wsr.Range("F" & Lignemax3) 'cellule Tarif A wsar
'wsau.Cells(j, "D").Copy wsr.Range("G" & Lignemax3) 'cellule Tarif B wsau
Lignemax3 = Lignemax3 + 1 'Nouvelle ligne vide
End If
Next j
Next i
MsgBox "Comparaison éffectuée"
End Subj'ai essayé avec ce code pour produire un 3eme classeur qui copie les résultats de la comparaison, mais je dois avoir un probleme avec le if, il ne declenche aucune copie...quelqu'un saurait pourquoi?
Moi, je ne peut vous aider...
Etant débutant dans excel, ceci est trop compliqué
Donc après de multiples essais, il ne manquait qu'un mot dans le code du dessus:
Par conséquent, le fichier fonctionne, il faut le placer dans le meme dossier que les fichiers a traiter(prevu pour les noms des fichiers envoyés, a adapter au cas ou).
Le traitement est deja fait car il prends un peu de temps(10 -15min environ et fonction de la machine).
Je vous laisse verifié.
je suis persuader qu'il existe une methode plus rapide...
Merci beaucoup de votre aide.
Je vous en suis fort reconnaissant.
Ça va me permettre de gagner du temps ....
Cordialement.