Otomatik Köprü Atama.

[constantinepolisi]

Merhaba Korhan Bey,
Kodlarınızı denedim tam istediğim on numara çalışıyor. Bunu gerçek dosyaya eklediğimde 2 kodun birleşmesi gerekiyor. Bildiğim tüm yolları denedim, sonuç alamadım. Diğer kodda birleşmesi gereken yerleri yaptım ama bunu yapamadım. Rica etsem siz birleştire bilir misiniz?
İyi çalışmalar dilerim.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
If Target.Row < 3 Then Exit Sub
If Target <> "" Then Target.Offset(0, -1) = Date
If WorksheetFunction.CountA(Target) = 0 Then Target.Offset(0, -1).Clear
Son:
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range, S2 As Worksheet, Adres As String
    If Intersect(Target, Range("A3:A" & Rows.Count, "C3:C" & Rows.Count)) Is Nothing Then Exit Sub
    Cells(Target.Row, "O").Clear
    If Cells(Target.Row, "A") <> "" And Cells(Target.Row, "C") <> "" Then
        Set S2 = Sheets("GÖNDERİLENLER")
        Set Bul = S2.Range("A:A").Find(Cells(Target.Row, "C"), , , xlWhole)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
                If Bul.Offset(0, 5) = Cells(Target.Row, "A") Then
                    With Cells(Target.Row, "O")
                        .Value = "Lİsteye Git"
                        .Font.Bold = True
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .Font.ColorIndex = 1
                    End With
                    Exit Do
                End If
                Set Bul = S2.Range("A:A").FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        End If
    End If
End Sub

 

[constantinepolisi]

Merhaba Korhan Bey,
Kodları birleştirdim sıkıntı yok. İlginiz için çok teşekkür ediyorum iyi ki varsınız. Bu yazdığınız kodlar bu çalışma arasında en gözde bir özellik oldu desem de yeridir.
Çok teşekkür ediyorum.
İyi çalışmalar dilerim iyi akşamlar.