Dur abey ayarlayayım bilgisayar açıp.

 If kacinci > 1 Then

        MsgBox "ilgili veri bulundu", vbInformation, "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

(24/10/2020, 23:06)feraz yazdı:

 If kacinci > 1 Then

        MsgBox "ilgili veri bulundu", vbInformation, "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

Allah razı olsun hocam, yine büyük bir dertten kurtardın beni. Eğer kasmaz ise çok güzel olacak. Tekrar tekrar teşekkür ederim.

(24/10/2020, 23:13)kanakan52 yazdı:

(24/10/2020, 23:06)feraz yazdı:

 If kacinci > 1 Then

        MsgBox "ilgili veri bulundu", vbInformation, "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

Allah razı olsun hocam, yine büyük bir  dertten kurtardın beni. Eğer kasmaz ise çok güzel olacak. Tekrar tekrar teşekkür ederim.

Sendende abey.Kasma felan yapmaz çünkü döngü yok

---

Yarın unutmazsam birde dictionary ve dizi ile yaparım örnek olması açısından.Tabii kodlar biraz uzar

(24/10/2020, 23:20)feraz yazdı:

(24/10/2020, 23:13)kanakan52 yazdı:

(24/10/2020, 23:06)feraz yazdı:

 If kacinci > 1 Then

        MsgBox "ilgili veri bulundu", vbInformation, "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

Allah razı olsun hocam, yine büyük bir  dertten kurtardın beni. Eğer kasmaz ise çok güzel olacak. Tekrar tekrar teşekkür ederim.

Sendende abey.Kasma felan yapmaz çünkü döngü yok

---

Yarın unutmazsam birde dictionary ve dizi ile yaparım örnek olması açısından.Tabii kodlar biraz uzar

Ara verince unuttum bildiklerimi, cok birşey bildigim yok zaten. Paylaşırsan incelerim hocam. Iyiki varsınız.

Kodlar altta abey.Resimdeki sarıya boyadığım yer seçilmeli.
Belki bu daha hızlı çalışır.Dictionary ce dizi ikilisi müthiş hızlı çalılıyor beraber.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim satir As Long, sutun As Byte, aranan, hedefsutun As String

    Dim dictt As Dictionary



    kacinci = 1

    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: Set dictt = dictBul(2)

            Case 6: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: Set dictt = dictBul(9)

            Case 18: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: Set dictt = dictBul(8)

        End Select

        varmi sutun, hedefsutun, satir, aranan, dictt

    End If

    Set dictt = Nothing

End Sub

Function varmi(alan As Byte, aranansutun As String, satir As Long, aranan, dict As Dictionary)

  Dim kacinci As Long

    If satir > 1 Then

        If Trim(Cells(satir, alan).Value) <> "" Then

            If Cells(satir, alan).Cells.Count = 1 Then kacinci = dict(CStr(aranan)) + 1

        End If

    End If

    

    If kacinci > 1 Then

        MsgBox "ilgili veri bulundu", vbInformation, "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

    Set bul = Nothing

End Function

Function dictBul(aralik As Byte) As Dictionary

    Dim dict As New Dictionary, dizi(), son As Long, i As Long

    son = Sayfa2.Range("A" & Rows.Count).End(3).Row

    If son < 2 Then son = 2

    dizi = Sayfa2.Range("a2:i" & son).Value

    For i = LBound(dizi) To UBound(dizi)

        If Not dict.Exists(CStr(dizi(i, aralik))) Then dict.Add CStr(dizi(i, aralik)), i

    Next

    Set dictBul = dict: Erase dizi

End Function