Problème de copie/recherche Instr

[Reizo]

Bonjour,

Voila j'ai un code (avec commentaires) qui fait une recherche partielle d'une feuille sur une autre et dès que ma fonction Instr retourne l'occurence, mon code est censé copier la ligne correspondante dans une nouvelle feuille, or, mon problème est que, au final ça me copie toutes les lignes analysées dans la nouvelle feuille, si quelqu'un a une solution voici mon code :

Private Sub CommandButton1_Click() 'Ceci est juste la définition de la fonction de recherche, le nom importe peu

    Dim iR As Long 'iR est l'indice de ligne recherchée, cette variable change dans la première boucle (elle passe en revue les lignes de Donery de 2 à 30000 sur la quatrième colonne)

    Dim iAV As Long 'Ceci est la ligne dans laquelle le résultat de la recherche sera collé sur une nouvelle feuille
    
    Dim iL As Long 'iL est l'indice de la ligne utilisée pour la recherche, cette variable change dans la deuxieme boucle

    Dim L1 As Long 'L1 est la ligne jusqu'à laquelle la premiere boucle parcourt le tableau
    
    Dim L2 As Long 'L2 est la ligne jusqu'à laquelle la deuxieme boucle parcourt le tableau
    
    Dim R As Worksheet 'Définition de la variable R comme étant une feuille excel

    Dim AV As Worksheet 'Définition de la variable AV comme étant une feuille excel

    Set R = Worksheets("Donery")  'Feuille de l'entreprise

    Set AV = Worksheets("Feuil1") 'Nouvelle feuille
    
    Set EQ = Worksheets("Equivalences") 'Feuille d'où provient la donnée de recherche
    
    Dim PositionOccurence As Integer
    
    iAV = 2 'Début de collage sur la nouvelle feuille à la ligne 2
    
    For iR = 2 To 50 'Boucle balayant toutes les lignes de l'entreprise concernée
        
        For iL = 2 To 4 'Boucle balayant toutes les lignes de références dans la feuille équivalences
        
        PositionOccurence = InStr(1, R.Cells(iR, 4).Value, EQ.Cells(iL, 7).Value, vbTextCompare)
        
            If PositionOccurence <> 0 Then
        
            R.Range(iR & ":" & iR).Copy AV.Cells(iAV, 1) 'Commande de copie
            
            iAV = iAV + 1 'Incrémentation du compteur de ligne sur laquelle la copie sera collée
            
            End If
        
        Next iL

    Next iR

End Sub

Merci pour votre aide, Bonne journée.

 

[Reizo]

Re : Problème de copie/recherche Instr

Problème résolu.