2 BDD, Trouver ligne selon 2 critères et copier une cellule

Bonjour,

Je suis un jeune novice en VBA, grâce au forum j'ai pu développer un code pour comparer 2 bases de donner mais je suis maintenant bloqué et je besoin de votre aide.

J'ai 2 BDD sur deux feuilles que nous appelerons feuille Bill et Feuill Sales.

Je souhaite avoir une marco pour aller chercher dans la Feuille Sales une ligne particulière (la ligne) qui correspond a 2 critères d'une ligne dans Feuille Bill (ligne de base). Critère : 2 valeur de cellules de la ligne égale

Une fois "la ligne" trouver dans la feuille Sales, je veux copier-coller la cellule de la colonne L de "la ligne" dans la colonne R de "la ligne de base" dans la feuille Bill.

J'étais parti sur des filtres sur mes colonnes des deux feuilles et utilisé des if. Le problème et que ca marche que si j'ai le même nombre de lignes sur mes deux feuilles (ce qui n'est pas forcement le cas....)

Je pense donc a du Vlookup selon deux critères pour trouver la bonne ligne et une fois la ligne trouver copier la cellule de la ligne trouver. Cela en boucle pour chaque ligne de la feuille Bill

Pouvez vous m'aider?

Merci d'avance

Ci dessous le code basic qui marche si la feuille Bill et Sales on le même nombre de ligne

Dim x As Long

For x = 2 To [P65536].End(xlUp).Row '

If Bill.Cells(x, "P") = Sales.Cells(x, "J") And Bill.Cells(x, "D") = Sales.Cells(x, "F")

'Si cell de la colonne P de Bill = cell de la colonne J de Sales et Si cell de la colonne D de Bill = cell de la colonne F de Sales : mes critères de recherche

Then Bill.Cells(x, "R") = Sales.Cells(x, "L")

Next x

Bonjour,

A+

Bonjour Galopin,

En pièce jointe le fichier en très simplifier et donc ca change ma description de colone.

Critère selection de la ligne dans SALES :

Cell colone C de Bill = Cell colone C de Sales AND Cell colone E de Bill = Cell colone D de Sales

Une fois ligne de Sales identifier :

Cell Colone F de Bill i = Cell colone E de Sales de la ligne identifier

Cela en boucle pour chaque ligne de la feuille Bill

Si pas de match alors laisser vide et passer à l'autre ligne

Merci de ton aide

Bonjour,

Hu... Je vais regarder mais ce n'est pas idéal :

Pour une macro les données on s'en fout, par contre tout ce qui est contextuel est essentiel, les colonnes , les lignes, les feuilles...

Bon je vais déjà me faire un petit graillon et après je te dis quoi...

Me dire le nombre de ligne (environ au vrai...)

A+

Bonjour,

Bon en l'absence de réponse, j'ai transposé ton modèle pour revenir à la disposition d'origine.

Sinon il y a toutes les chances que tu n'y retrouves pas tes petits...

La macro :

Sub galopin()
Dim i&, j&, iA&, iB&, a, b, Y As Boolean

Dim WsA As Worksheet, WsB As Worksheet
Set WsA = Sheets("Bill")
Set WsB = Sheets("Sales")

iA = WsA.Cells(Rows.Count, 1).End(xlUp).Row
iB = WsB.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

a = WsA.Range("D1:P" & iA)
b = WsB.Range("F1:L" & iB)

   For i = 2 To iB
      For j = 2 To iA
      Y = b(i, 5) = a(j, 13) And b(i, 1) = a(j, 1)
         If Y Then
            WsA.Cells(j, 18) = b(i, 7)
            Exit For
         End If
      Next j
   Next i
End Sub

Remarque : Heu... Ce n'est pas ce qu'on fait de plus rapide, mais si tu n'as pas trop de lignes à traiter, ça ira très bien.

Pour plus de 100 000 lignes, je peux encore améliorer un peu ! Dans ce cas me le signaler.

A+

Galopin,

Ton code marche à la perfection! C'est trop top! Merci

Juste un ajouts a demander car j'arrive pas a le faire, ca bloque

Comment updater le code pour qu'en plus de coller la cell de la colonne L de Sales en cell de la colonne R de Bill

Then Bill.Cells(x, "R") = Sales.Cells(x, "L")

que tu as traduit en

WsA.Cells(j, 18) = b(i, 7)

Il fasse aussi :

Bill.Cells(x1, "W") = Sales.Cells(x1, "O")

J'arrive pas a transposer avec ton code comme model...

Merci Beaucoup en tout cas

Il faut modifier la source :

b = WsB.Range("F1:O" & iB)

ensuite :

         If Y Then
            WsA.Cells(j, 18) = b(i, 7)
            WsA.Cells(j, 23) = b(i, 10)   'insérer cette ligne
            Exit For                      'La suite sans changement

A+

Juste parfait!

Merci!