Selection Change olayında Hücrelerin tamamı tetikleniyor

[Karamanli.70]

Üstadlar. Herkese iyi günler. Ekte gönderdiğim excelde Per_List sekmesinde unvan adını girince kod1 ve kod2 ler sabitler sekmesindeki alan düşeyara mantığı ile kodları okuyup otomatik getiren bir kodum var. Ancak selection change olayında dolu son hücreden başlamak üzere çalışması gerekli iken tüm hücreler her seferinde tekrar tekrar doluyor. son hücreden itibaren yazılan unvanın karşısından devam etmek üzere çalışması için ne yapmak lazım?

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

For i = 2 To 5000

If Worksheets("Per_List").Cells(i, 3).Value = "" Then Exit For

On Error Resume Next

Worksheets("Per_List").Cells(i, 1).Value = Application.WorksheetFunction.VLookup( _
Worksheets("Per_List").Cells(i, 3).Value, Worksheets("SABİTLER").Range("a:c"), 2, 0)

Worksheets("Per_List").Cells(i, 2).Value = Application.WorksheetFunction.VLookup( _
Worksheets("Per_List").Cells(i, 3).Value, Worksheets("SABİTLER").Range("a:c"), 3, 0)

Next
End Sub

 

[muygun]

Merhaba;
Per_List sayfasındaki kodları silin ve;

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Set s1 = ThisWorkbook.Worksheets("SABİTLER")
sonn = s1.Range("A65536").End(xlUp).Row
sat = Target.Row
süt = Target.Column
If sat >= 2 And süt = 3 And Cells(sat, süt) <> "" Then
aranan = Cells(sat, 3): bulunanno = 0
bulunanno = WorksheetFunction.Match(aranan, s1.Range("a1:a" & sonn), 0)
If bulunanno >= 1 Then
Cells(sat, 1) = s1.Cells(bulunanno, 2)
Cells(sat, 2) = s1.Cells(bulunanno, 3)
End If
End If
End Sub

Şeklinde düzenleyip deneyin.
İyi çalışmalar.

 

[Karamanli.70]

Çok teşekkür ederim elinize sağlık.