Hilfe bei Find und SelectionChange

Hallo,
Hallo , in Tabelle 1 Spalte D möchte ich die Kürzel aus Tabelle2, Spalte B eingeben und es soll automatisch der Wert aus Tabelle2 Spalte C in Tabelle 1 Spalte D übernommen werden. Die Übernahme klappt zwar, aber nicht zufriedenstellend. Die Suche klappt leider nicht.
1. Problem, genaue Übereinstimmung funzt nicht
2. Problem, der Wert wird nicht sofort übernommen, sondern erst wenn ich die Zelle manuell verlasse und wieder anklicke. Wie kann ich das ändern?
https://www.herber.de/bbs/user/158564.xlsm

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ort As String
Dim Ziel As Variant

On Error Resume Next

If Target.Column = 4 Then
    If Len(Target.Value) > 3 Then
        Exit Sub
    Else
         Ziel = ActiveCell.Address
         Ort = Range(Ziel).Value
         Dim Finden As Range
         Set Finden = Worksheets("Tabelle2").Range("B2:B1000").Find(what:=Ort, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)
         Worksheets("Tabelle2").Cells(Finden.Row, 3).Copy
         Range(Ziel).PasteSpecial


    End If
   End If
End Sub