öncelikle dosyanız xlsm yada xlsb olmalı
1 - çalışmanıza bir modül ekleyin
modüle eklenecek kod:

Function AdresIlIlce(ByVal Rng As Range) ' As String

Dgr = ""

If Len(Rng.Value & "") = 0 Then GoTo Son

    Dgr = Trim(Rng.Value)

    Dgr = Mid(Dgr, InStrRev(Dgr, " ") + 1)

Son:

    Rng.Offset(, 2) = Dgr

End Function

2 - veri sayfasının kod sayfasına aşağıdaki kodu ekleyin

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("K:K")) Is Nothing Then 'sadece K sütununa bakar

    Dim cll As Range

    AdrX = Target.Address

    If InStr(AdrX, ":") > 0 Then ilk = Split(AdrX, "$")(2): Son = Split(AdrX, "$")(4) Else ilk = Split(AdrX, "$")(2) & ":": Son = Split(AdrX, "$")(2)

   

    Set Trgt = Range("K" & ilk & "K" & Son)

   

    For Each cll In Trgt

    Set Rng = cll

         AdresIlIlce (Rng)

    Next cll

End If



End Sub

dilerim işinize yarar