Replicare dei valori

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then Exit Sub
Dim ur, r, c As Object, Msg As String, val As Long, Tot As Long
ur = Sheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then
        val = Target.Offset(0, 0)
         With Sheets("Foglio2").Range("A1:A" & ur)
            Set c = .Find(val, LookIn:=xlValues, LookAt:=xlWhole)
                If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                r = c.Row
                Msg = Msg & Sheets("Foglio2").Cells(r, 2) & ","
                Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
        End With
   End If
Application.EnableEvents = False
    Target.Offset(0, 1) = Msg
Application.EnableEvents = True
End Sub