Condition sur Egalité de deux cellules dans deux feuilles différentes.

[balou88]

Bonjour à tous et toutes!

J'ai un petit probléme dans mon code VBA. En effet je cherche dans une double boucle à vérifier l'égalité entre deux cellules qui n'appartiennent pas aux mêmes feuilles.
Plus que des grands discours voici mon code...

Sub Maj_reste_a_livrer()

Dim nb_ligne_res As Integer  'nombre de ligne de resultats
Dim nb_ligne_liv As Integer  'nombre de ligne de reste à livrer
Dim j As Integer, i As Integer


Sheets("Resultats").Activate
nb_ligne_res = WorksheetFunction.CountA(Range("A:A"))

Sheets("Reste à livrer").Activate
nb_ligne_liv = WorksheetFunction.CountA(Range("A:A"))

For i = 2 To nb_ligne_res  'boucle sur les résultats de contrôle
    For j = 2 To nb_ligne_liv ' boucle sur les reste à livrer (à modifier)
    If Sheets("Resultats").Cells("D" & i) = Sheets("Reste à livrer").Cells("A" & j) And Sheets("Resultats").Cells("J" & i).Value = "KO" Then 'erreur à ce ni



 Sheets("Reste à livrer").Cells("F" & j) = Sheets("Resultats").Cells("A" & i)
 Sheets("Reste à livrer").Cells("G" & j) = Sheets("Resultats").Cells("K" & i)
 Sheets("Reste à livrer").Cells("H" & j) = Sheets("Resultats").Cells("L" & i)
 Sheets("Reste à livrer").Cells("I" & j) = Sheets("Resultats").Cells("M" & i)
 
End If

If Sheets("Resultats").Cells("D" & i).Value = Sheets("Reste à livrer").Cells("A" & j).Value And Sheets("Resultats").Cells("J" & i).Value = "OK" Or "RET" Then
    
        Rows("j:j").Select
    Selection.Delete Shift:=xlUp
  End If
  


 Next j
 Next i

End Sub

Le probléme survient à la ligne :

If Sheets("Resultats").Cells("D" & i) = Sheets("Reste à livrer").Cells("A" & j) And Sheets("Resultats").Cells("J" & i).Value = "KO"

et c'est une erreur d'execution '1004'
"Erreur définie par l'application ou par l'objet" (toujours aussi explicite! )


En gros je compare les valeurs de la colonne A du reste à livrer et la colonne D des résultats et si celles-ci son identiques j'agit, sinon je continue ma boucle...

J'éspére avoir été claire, n'hésitait pas à me revenir pour de plus amples informations...



Merci à tous!!

 

[CedricBDO]

Re : Condition sur Egalité de deux cellules dans deux feuilles différentes.

J'ai eu le même problème, tu devrais avoir ta réponse dans ce post.

https://www.excel-downloads.com/threads/vba-comparer-cellules-deplacer-lignes.167703/

 

[balou88]

Re : Condition sur Egalité de deux cellules dans deux feuilles différentes.

Merci,

Mais je n'arrive pas vraiment à adapter...Je crois que pour mon cas il me faut réellement une double boucle non?



A+

 

[balou88]

Re : Condition sur Egalité de deux cellules dans deux feuilles différentes.

J'ai essayé d'adapter de cette maniére (en rajoutant des commentaires pour bien comprendre mon but...
Malheuresement j'ai toujours le même message d'erreur malgré l'utilisation de la fonction "Match"....HELP

Sub Maj_reste_a_livrer()

Dim nb_ligne_res As Integer  'nombre de ligne de resultats
Dim nb_ligne_liv As Integer  'nombre de ligne de reste à livrer
Dim j As Integer, i As Integer


Sheets("Resultats").Activate
nb_ligne_res = WorksheetFunction.CountA(Range("A:A"))

Sheets("Reste à livrer").Activate
nb_ligne_liv = WorksheetFunction.CountA(Range("A:A"))

For i = 2 To nb_ligne_res  'boucle sur les résultats de contrôle
    For j = 2 To nb_ligne_liv ' boucle sur les reste à livrer (à modifier)
    If WorksheetFunction.Match(Worksheets("Resultats").Cells("D" & i).Value, Worksheets("Reste à livrer").Cells("A" & j).Value, 0) Then 'Toujours le même probléme à ce niveau la!
    
    
    If Sheets("Resultats").Cells("J" & i).Value = "KO" Then  ' si objet KO intégration des données de "Resultats" dans "Reste à livrer"

 Sheets("Reste à livrer").Cells("F" & j) = Sheets("Resultats").Cells("A" & i)
 Sheets("Reste à livrer").Cells("G" & j) = Sheets("Resultats").Cells("K" & i)
 Sheets("Reste à livrer").Cells("H" & j) = Sheets("Resultats").Cells("L" & i)
 Sheets("Reste à livrer").Cells("I" & j) = Sheets("Resultats").Cells("M" & i)
 
End If

If Sheets("Resultats").Cells("J" & i).Value = "OK" Or "RET" Then 'si objet "OK" ou "RET" supression de la ligne dans "Reste à livrer" et "j=j-1" pour ne pas rater de ligne...
    
        Rows("j:j").Select
    Selection.Delete Shift:=xlUp
    j = j - 1
  End If
  
End If

 Next j
 Next i

End Sub

Merci d'avance!

 

[balou88]

Re : Condition sur Egalité de deux cellules dans deux feuilles différentes.

J'ai réussi
Pour ceux que ça interesse voici le code :

Sub Maj_reste_a_livrer()

Dim nb_ligne_res As Integer  'nombre de ligne de resultats
Dim nb_ligne_liv As Integer  'nombre de ligne de reste à livrer
Dim j As Integer, i As Integer


Sheets("Resultats").Activate
nb_ligne_res = WorksheetFunction.CountA(Range("A:A"))

Sheets("Reste à livrer").Activate
nb_ligne_liv = WorksheetFunction.CountA(Range("A:A"))

For i = 2 To nb_ligne_res  'boucle sur les résultats de contrôle

j = WorksheetFunction.Match(Worksheets("Resultats").Cells(i, 4).Value, Worksheets("Reste à livrer").Columns(1), 0)  'Toujours le même probléme à ce niveau la!
    
    
    If Sheets("Resultats").Cells(i, 10).Value = "KO" Then ' si objet KO intégration des données de "Resultats" dans "Reste à livrer"

 Sheets("Reste à livrer").Cells(j, 6) = Sheets("Resultats").Cells(i, 1)
 Sheets("Reste à livrer").Cells(j, 7) = Sheets("Resultats").Cells(i, 11)
 Sheets("Reste à livrer").Cells(j, 8) = Sheets("Resultats").Cells(i, 12)
 Sheets("Reste à livrer").Cells(j, 9) = Sheets("Resultats").Cells(i, 13)
 
End If

If Sheets("Resultats").Cells(i, 10).Value = "OK" Then 'si objet "OK" ou "RET" supression de la ligne dans "Reste à livrer" et "j=j-1" pour ne pas rater de ligne...
    
    Sheets("Reste à livrer").Rows(j).Select
    Selection.Delete Shift:=xlUp
  End If
  



 Next i

End Sub

Merci en tout cas pour le tuyau sur la fonction match!


A+