Récupération d'adresses de cellules dans une boucle

Bonjour au forum,

J'ai écris ce code pour comparer deux plages de cellules situées dans deux onglets différents.

Je souhaiterais pour voir récupérer l'adresse des cellules où une ou plusieurs occurrences sont présentes et les afficher à la suite du texte que j'applique en colonne 30 (AF).

Sub ComparaisonColonne()

Dim strNomFeuille1 As String, strNomFeuille2 As String
Dim Liste1 As Range, Liste2 As Range
Dim C1 As Range, C2 As Range, Cpt As Integer
Dim dl1 As Long, dl2 As Long
'-------------------------------------------------------------------------------------'
strNomFeuille1 = InputBox("Nom de la feuille contenant la 1ère plage de cellules à comparer : ")
strNomFeuille2 = InputBox("Nom de la feuille contenant la 2nde plage de cellules à comparer : ")

dl1 = Sheets(strNomFeuille1).Range("B" & Rows.Count).End(xlUp).Row
dl2 = Sheets(strNomFeuille2).Range("B" & Rows.Count).End(xlUp).Row

Set Liste1 = Sheets(strNomFeuille1).Range("B6:B" & dl1)
Set Liste2 = Sheets(strNomFeuille2).Range("B6:B" & dl2)
'-------------------------------------------------------------------------------------'
Application.ScreenUpdating = False
'-------------------------------------------------------------------------------------'
For Each C2 In Liste2 ' pour chaque cellule de la plage de cellules n°2
    Cpt = 0 ' on réinitialise le compteur
    For Each C1 In Liste1 ' pour chaque cellule de la plage de cellules n°1
        If UCase(C1) = UCase(C2) Then Cpt = Cpt + 1 ' on compare chaque valeur des cellules de la liste n°1 avec la 1ère cellule de la liste n°2, et ainsi de suite
        ' si on trouve une correspondance, on incrémente le compteur de 1
    Next C1
    If Cpt = 0 Then
            C2.Offset(, 30) = "Aucune occurrence dans la liste du " & strNomFeuille1 ' si le compteur est égal à 0, on affiche le texte dans la colonne n°30 (AF)
            C2.Interior.Color = RGB(235, 241, 222)
    ElseIf Cpt = 1 Then
            C2.Offset(, 30) = "Une occurrence présente dans la liste du " & strNomFeuille1 '& ", dans la cellule : " & C1.Address ' si le compteur est égal à 1, on affiche le texte dans la colonne n°30 (AF)
            C2.Interior.Color = RGB(253, 233, 217)
    Else
            C2.Offset(, 30) = "Plusieurs occurrences présente dans la liste du " & strNomFeuille1 '& ", dans les cellules : " & si le compteur est supérieur à 1, on affiche le texte dans la colonne n°30 (AF)
            C2.Interior.Color = RGB(242, 220, 219)
    End If
Next C2
'-------------------------------------------------------------------------------------'
Application.ScreenUpdating = True
'-------------------------------------------------------------------------------------'
Set Liste1 = Nothing
Set Liste2 = Nothing

End Sub

Je débute en VBA et ai du mal à voir comment je pourrais arriver à cela en étant dans une boucle...

Merci pour votre aide :)

Salut,

Une méthode parmi d'autres en incrémentant une chaine...

Sub ComparaisonColonne()
Dim strNomFeuille1 As String, strNomFeuille2 As String
Dim Liste1 As Range, Liste2 As Range
Dim C1 As Range, C2 As Range, Cpt As Integer
Dim dl1 As Long, dl2 As Long
Dim strTmp
    strNomFeuille1 = InputBox("Nom de la feuille contenant la 1ère plage de cellules à comparer : ")
    strNomFeuille2 = InputBox("Nom de la feuille contenant la 2nde plage de cellules à comparer : ")

    dl1 = Sheets(strNomFeuille1).Range("B" & Rows.Count).End(xlUp).Row
    dl2 = Sheets(strNomFeuille2).Range("B" & Rows.Count).End(xlUp).Row

    Set Liste1 = Sheets(strNomFeuille1).Range("B6:B" & dl1)
    Set Liste2 = Sheets(strNomFeuille2).Range("B6:B" & dl2)
    Application.ScreenUpdating = False
    For Each C2 In Liste2    ' pour chaque cellule de la plage de cellules n°2
        Cpt = 0    ' on réinitialise le compteur
        strTmp = ""
        For Each C1 In Liste1    ' pour chaque cellule de la plage de cellules n°1
            If UCase(C1) = UCase(C2) Then
                    Debug.Print "C2:"; C2; " C1:"; C1; " Cpt:"; Cpt
                strTmp = strTmp & "(" & C1.AddressLocal(False, False) & ") "
                Cpt = Cpt + 1    ' on compare chaque valeur des cellules de la liste n°1 avec la 1ère cellule de la liste n°2, et ainsi de suite
                ' si on trouve une correspondance, on incrémente le compteur de 1
            End If
        Next C1

        If Cpt = 0 Then
            C2.Offset(, 30) = "Aucune occurrence dans la liste du " & strNomFeuille1    ' si le compteur est égal à 0, on affiche le texte dans la colonne n°30 (AF)
            C2.Interior.Color = RGB(235, 241, 222)
        ElseIf Cpt = 1 Then
            C2.Offset(, 30) = "Une occurrence présente dans la liste du " & strNomFeuille1 & " dans les cellules : " & strTmp   '& ", dans la cellule : " & C1.Address ' si le compteur est égal à 1, on affiche le texte dans la colonne n°30 (AF)
            C2.Interior.Color = RGB(253, 233, 217)
        Else
            C2.Offset(, 30) = "Plusieurs occurrences présente dans la liste du " & strNomFeuille1 & " dans les cellules : " & strTmp   '& ", dans les cellules : " & si le compteur est supérieur à 1, on affiche le texte dans la colonne n°30 (AF)
            C2.Interior.Color = RGB(242, 220, 219)
        End If
    Next C2
    '------------------------------------
    Application.ScreenUpdating = True
    '------------------------------------
    Set Liste1 = Nothing
    Set Liste2 = Nothing

End Sub

Salut Jean-Paul,

Merci beaucoup pour ta réponse, c'est parfait pour moi :)

Excellente journée à toi !