VBA Excel : Comparaison de cellules et BDD

Fermé
clementt - 18 avril 2012 à 11:54
 Yoda - 18 avril 2012 à 14:02
Bonjour,

Je suis débutant sur VBA et j'ai besoin de votre aide (comme beaucoup de gens qui postent dans cette section).

Le problème est le suivant:

J'ai sur une feuille "Ecran_Consultation" deux cellules O2, P2, et je veux les comparer à une base de données présente sur une autre feuille portant le nom de "BDD"

Si les deux cellules existent dans la BDD sur une même ligne (dans les colonnes A et C), je les copie dans uns troisième feuille, qui s'appelle "Mise_en_forme".

Je pense avoir deux problèmes:

- le premier est dans la comparaison des cellules, je n'arrive pas à faire en sorte que celà fonctionne.

- Le deuxième est dans la boucle, je ne suis pas certain qu'elle ratisse l'ensemble de la feuille "BDD"

Voici le code:

Sub Bouton_Consultation_TEST()

Dim Source As Range
Dim Destination As Range
Dim DernLigne As Long

Dim TEST1 As Range
Dim TEST2 As Range
Dim TEST11 As Range
Dim TEST22 As Range
Dim i As Integer

DernLigne = Sheets("BDD").Range("A65536").End(xlUp).Row
Set TEST1 = Sheets("Ecran_Consultation").Range("O2")
Set TEST2 = Sheets("Ecran_Consultation").Range("P2")

For i = 2 To DernLigne = Sheets("BDD").Range("A65536").End(xlUp).Row

Set TEST11 = Sheets("BDD").Range("A" & i)
Set TEST22 = Sheets("BDD").Range("C" & i)

If TEST1.Value = TEST11.Value Then
If TEST2.Value = TEST22.Value Then
Set Source = TEST11 'Définition de la plage à copier
Set Destination = Sheets("Mise_en_forme").Range("A1")
Source.Copy
Destination.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set Source = TEST22
Set Destination = Sheets("Mise_en_forme").Range("B1")
Source.Copy
Destination.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If

Next

End Sub

Merci!
Cleément
A voir également:

1 réponse

Bonjour,

voici comment j'écrirai la boucle For

For i = 2 To DernLigne
   Set TEST11 = Sheets("BDD").Range("A" & i) 
   Set TEST22 = Sheets("BDD").Range("C" & i) 
   If TEST1.Value = TEST11.Value Then 
      If TEST2.Value = TEST22.Value Then 
         Set Source = TEST11 'Définition de la plage à copier 
         Set Destination = Sheets("Mise_en_forme").Range("A1") 
         Destination.Value = Source.Value
         Set Source = TEST22 
         Set Destination = Sheets("Mise_en_forme").Range("B1") 
         Destination.Value = Source.Value
      End If 
   End If 
Next 


A+.
0