Marco copie cellule mirroir

Bonjour,

voila j'ai recuperé je ne sais plus ou une macro qui fonctionnait super bien :

en fait c'est un distancier j'ai une liste de ville colonne A et la meme liste ligne 1
a l'intersection des meme nom la case se grise
je voudrais lorsque je remplie par exemple armentieres - bailleul 10 (km) que la cellule a l'intersection bailleul armentiere se remplisse toute seule 10

voila ma macro qui fonctionnait mais je ne sais pas pourquoi bug

Private Sub Worksheet_Change(ByVal Target As Range)
Dim villeligne As Range
Dim villecolonne As Range
Application.EnableEvents = False
Set villecolonne = Range("A2:A1000")
Set villeligne = Range("B1:HZ1")
lig = Target.Row
col = Target.Column
ville1 = Range("A" & lig): ville2 = Cells(1, col)
'Stop
With villecolonne
Set c = .Find(ville2)
If Not c Is Nothing Then
adres2 = c.Address
numeligne = c.Row
End If
End With
With villeligne
Set c = .Find(ville1)
If Not c Is Nothing Then
adres1 = c.Address
numecol = c.Column
End If
End With
Cells(numeligne, numecol) = Target.Value
'Stop
Application.EnableEvents = True
End Sub

merci d'avance