26/10/2020, 14:12
Alttakide hızlı çalışır abey.Abuda son örnek olsun 
Excel ile ilgili sorularınızı bekleriz
Excel ile ilgili sorularınızı bekleriz
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
Dim satir As Long, sutun As Byte, aranan, hedefsutun As String
If Not Intersect(Target, Range("B2:B1048576,F2:F1048576,R2:R1048576")) Is Nothing Then
Select Case Target.Column
Case 2: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "B:B"
Case 6: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "i:i"
Case 18: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "H:H"
End Select
varmi sutun, hedefsutun, satir, aranan
End If
End Sub
Function varmi(alan As Byte, aranansutun As String, satir As Long, aranan)
Dim kacinci As Long
If satir > 1 Then
If Trim(Cells(satir, alan).Value) <> "" Then
If Cells(satir, alan).Cells.Count = 1 Then
On Error GoTo son
kacinci = WorksheetFunction.Match(aranan, Sayfa2.Range(aranansutun), 0)
End If
End If
End If
If kacinci > 0 Then
MsgBox "ilgili veri bulundu", vbCritical, "mükerrer"
Application.EnableEvents = False
Cells(satir, 1).Value = Sayfa2.Cells(kacinci, 1).Value
Cells(satir, 6).Value = Sayfa2.Cells(kacinci, 9).Value
Application.EnableEvents = True
End If
son:
On Error GoTo 0
Set bul = Nothing
Application.EnableEvents = True 'extra 2 defa yazildi
End Function