Köprüye makro ekleme

[baygal]

merhabalar
sayfa1 deki verilerin karşılığını diğer sayfalardaki aynı isimli detaylı haline köprü yapmak istiyorum.manuel köprü oluşturmak kolay fakat diğer sayfalardaki verilerin yeri değiştiğinde köprü geçersiz olur.kısaca sayfa1 deki isimlerin karşılığını verilerin yeri değişse bile gitsin hangi sayfada olursa olsun aynı isimli değere köprü oluştursun.yardımcı olursanız çok sevinirim...

 

[baygal]

Dosyayı ekledim..

 

[Ömer]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayınız. A sütunundaki veriye çift tıkladığınızda ilgili hücreye gidecektir..

Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range, S1 As Worksheet
Set S1 = Sheets("Sheet1")
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    Set c = S1.[A:A].Find(Target, LookAt:=xlWhole)
    If Not c Is Nothing Then
        S1.Select
        c.Select
    Else
        MsgBox "Veri Bulunamadı.."
    End If
End Sub

.

 

[baygal]

kodu nasıl kopyalayacağımı bilmiyorum... söylediğinizi yapamadım

 

[Ömer]

Önce boş bir sayfa açarak Araçlar / Makro / Güvenlik ekranından Düşük(önerilmezi) işaretleyerek tamam butonuna basın ve sayfayı kapatın. Bu işlemi bir kere yapmanız yeterli olur.

Daha sonra dosyanızı açın köprü kurmak istediğiniz sayfada iken sayfa adı üzerine sağ klik yaparak "kod görüntüle" seçeneğini işaretlerseniz bir sayfa açılır verdiğim kodları o sayfaya kopyalayın ve dosyayı kaydedin.

.

 

[baygal]

aklına sağlık !!! çok teşekkürler oldu...fakat tam sonuca ulaşamadık.sayfa1 de CHEESE CKMEYVELI (119066) nin karşılığı sheet2 de olduğu için bulamıyor..yani kod sadece sheet1 e tanımlı.
aranacak veriler belki 5 sayfada olacak...yani sayfa1 de ki verileri hangi sayfada olursa olsun bulacak bir kod nasıl tanımlayabiliriz ...

 

[Ömer]

Bu şekilde deneyiniz..

Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range, sayfa As Worksheet
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    For Each sayfa In Sheets
        Set c = sayfa.[A:A].Find(Target, LookAt:=xlWhole)
        If Not c Is Nothing Then
            sayfa.Select
            c.Select
        End If
    Next sayfa
End Sub

.

 

[baygal]

denedim oldu...çok teşekkür ..harika oldu.aklına sağlık kolay gelsin