Alternatif kod.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Row < 2 Then Exit Sub

    If Target.Column <> 11 Then Exit Sub

    If Target.Rows.Count <> 1 Then Exit Sub

    If Mid(Target.Value, InStrRev(Target.Value, " ") + 1) = "" Then

        Cells(Target.Row, "M").Value = ""

    Else

        Cells(Target.Row, "M").Value = Mid(Target.Value, InStrRev(Target.Value, " ") + 1)

    End If

End Sub

@feraz hocam yukardaki kod birden fazla hücre ekleyip sildiğimizde çalışmıyor galiba?

bu arada kendi kodumda da düzeltme yaptım ilk satırda değişiklik olmaması için satır kontrolünü ekledim

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

        If cll.Row > 1 Then 'satır kontrolü

            Set Rng = cll

            AdresIlIlce (Rng)

        End If

    Next cll

End If



End Sub

yada

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)

    If ilk = "1:" Then ilk = "2:"

    If Son < 2 Then Son = 2

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



    For Each cll In Trgt

            Set Rng = cll

            AdresIlIlce (Rng)

    Next cll

End If



End Sub

(15/08/2021, 09:59)berduş yazdı: @feraz hocam yukardaki kod birden fazla hücre ekleyip sildiğimizde çalışmıyor galiba?

Target.Rows.Count <> 1 Then Exit Sub
Yukardaki kodu eklemiştim abey çoklu veri girince hata vermesin diye.

Birden bzla silme yada kopyalayıp yapıştırmada bir döngü kurulur mesela
for i = Selection.row to Selection.rows.count -1
Sonra burda işlem kodları eklenir.
Ben instrew kodu göstermiştim bu aramaya sondan başlıyor.instr nin tersi yani.

---

InStrRev(Target.Value, " ")

Berduş hocam o kadar kod yazmadan yukardaki basitçe buluyor örnek
Gfgjgddaaghhdag  burda a bulunacaksa sonuç 14 verir abey

Private Sub Worksheet_Change(ByVal Target As Range)

Dim parca As String, i As Long, kacinci As Integer



    If Target.Row < 2 Then Exit Sub

    If Target.Column <> 11 Then Exit Sub

      

    If Target.Rows.Count = 1 Then

        kacinci = InStrRev(Target.Value, " ")

        If kacinci > 0 Then

            parca = Mid(Target.Value, kacinci + 1)

            Cells(Target.Row, "M").Value = IIf(parca = "", "", parca)

        Else

            Cells(Target.Row, "M").Value = ""

        End If

    ElseIf Target.Rows.Count > 1 Then

        For i = Selection.Row To (Selection.Cells.Count - 1) + Selection.Row

            kacinci = InStrRev(Cells(i, Target.Column).Value, " ")

            If kacinci > 0 Then

                parca = Mid(Cells(i, Target.Column).Value, kacinci + 1)

                Cells(i, "M").Value = IIf(parca = "", "", parca)

            Else

                Cells(i, "M").Value = ""

            End If

        Next

    End If

End Sub

Buda hızlı veriyon

Private Sub Worksheet_Change(ByVal Target As Range)

Dim parca As String, i As Long, kacinci As Integer

Dim arr, say As Long, secilenRow As Long

Const AktarmaSutun As String = "M"



    If Target.Row < 2 Then Exit Sub

    If Target.Column <> 11 Then Exit Sub

      

    If Target.Rows.Count = 1 Then

        kacinci = InStrRev(Target.Value, " ")

        secilenRow = Target.Row

        If kacinci > 0 Then

            parca = Mid(Target.Value, kacinci + 1)

            Cells(Target.Row, AktarmaSutun).Value = IIf(parca = "", "", parca)

        Else

            Cells(Target.Row, AktarmaSutun).Value = ""

        End If

    ElseIf Target.Rows.Count > 1 Then

        secilenRow = Selection.Row

        ReDim arr(1 To (Selection.Cells.Count - 1) + Selection.Row, 1 To 1)

        For i = Selection.Row To (Selection.Cells.Count - 1) + Selection.Row

            kacinci = InStrRev(Cells(i, Target.Column).Value, " ")

            If kacinci > 0 Then

                say = say + 1

                parca = Mid(Cells(i, Target.Column).Value, kacinci + 1)

                arr(say, 1) = IIf(parca = "", "", parca)

            Else

                say = say + 1: arr(say, 1) = ""

            End If

        Next

    End If

    If say > 0 Then Cells(secilenRow, AktarmaSutun).Resize(say, 1).Value = arr

    On Error Resume Next

    Erase arr

End Sub