Incrémentation VBA

Bonjour,

Alors mon probleme c'est que j'ai un doc execel avec 3 feuilles 2 de references et une pour faire la correspondance entre les deux et copier dans la 3eme quand il y a une correspondance. Voici mon code :

Sub Correspondance()

    Dim i As Integer
    i = 2
    While i <= 40
        Dim j As Integer
        j = 2
        While j <= 14924

        Dim k As Integer
        k = 2
            If Worksheets("Applis").Range("A" + CStr(i)).Value = Worksheets("Produits").Range("A" + CStr(j)).Value Then

                Worksheets("Applis").Range("A" + CStr(i)).Copy Destination:=Worksheets("Synthesevba").Range("A" + CStr(k))
                Worksheets("Applis").Range("E" + CStr(i)).Copy Destination:=Worksheets("Synthesevba").Range("B" + CStr(k))
                Worksheets("Produits").Range("E" + CStr(j)).Copy Destination:=Worksheets("Synthesevba").Range("C" + CStr(k))
        k = k + 1

            End If

            j = j + 1

        Wend
        i = i + 1
    Wend
End Sub

Mon soucis est que dans ma feuille Synthesevba il copie sur la deuxieme ligne mais ecrase par la suite il ne passe pas à la ligne suivante pour faire la copie. Auriez vous une solution ou une piste cela m'aiderait tres fortement ! Merci beaucoup

Bonjour et bienvenu,

Le code sans le support fichier ne sert pas pour lancer des tests. Mets-nous à notre disposition le fichier qui va avec.