Hücresi değişebilecek değere köprü oluşturmak

[tafababaji]

Merhaba,

Excel'de isimler ve detay olmak üzere iki sayfam var.
isimler sayfasında A1 hücresinde Ali yazıyor. Ben isimler:A1 e tıkladığımda "detay" sayfasında "Ali" yazan hücreyi bulup ona gitmesini istiyorum. Bunu nasıl yapabilirim?
Detay sayfasında Ali yazan hücrenin yeri değişebiliyor.

Şimdiden teşekkür ederim.

 

[sakman26]

selam,
örnek dosya olmadan ne yapılmak istendiği tam anlaşılamıyor.
Forumda arama yaparsanız bir çok örnek bulabilirsiniz...
Bir çok farklı örnek içeren bir dosya ektedir. İnceleyiniz.

link : http://s5.dosya.tc/server/urhfw3/KopruHK_1.xlsx.html

 

[tafababaji]

Aşağıda örnek dosya yükledim. Gönderdiğiniz excel'i de inceledim ama yapmak isteğimi yapamadım.

Yapmaya çalıştığım isimler sayfasındaki A1'e yani Ali yazan hücreye tıkladığımda detay sayfasında Ali yazan hücreyi bulup ona gitmek.

http://s8.dosya.tc/server2/01663s/KopruTest.xlsx.html

 

[tahsinanarat]

Dosyanız ekte

Ekli dosyanızı inceleyiniz, kodlar evvelce bu siteden temin edilen kodlardır.

Sub Koprukur()
Worksheets("isimler").Range("A2:A65536").Hyperlinks.Delete
Worksheets("detay").Range("a2:a65536").Hyperlinks.Delete
For Each c In Worksheets("isimler").Range("a2:a65536")
If c.Value <> "" Then
bul = c.Value
If bul <> "" Then
Set d = Worksheets("detay").Range("a2:a65536").Find(bul, LookAt:=xlWhole)
If Not d Is Nothing Then
firstAddress = d.Address
Do
On Error Resume Next
Worksheets("isimler").Range(c.Address).Hyperlinks.Add Anchor:=Worksheets("isimler").Range(c.Address), Address:="", SubAddress:="detay!" & firstAddress
Worksheets("detay").Range(d.Address).Hyperlinks.Add Anchor:=Worksheets("detay").Range(d.Address), Address:="", SubAddress:="isimler!" & Worksheets("isimler").Range(c.Address).Address
Set d = Worksheets("detay").Cells.FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress
End If
End If
End If
Next c
End Sub
Sub Koprusil()

'Removes hyperlinks from the active worksheet
'Does not delete the hyperlink text, only the link to the site
    Do Until ActiveSheet.Hyperlinks.Count = 0
        ActiveSheet.Hyperlinks(1).Delete
    Loop
    Columns("a:a").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("a2").Select

End Sub

 

[tafababaji]

Teşekkür ederim. Dosyayı indiremiyorum. Dosya.tc sitesine yüklemeniz mümkün müdür?

 

[tahsinanarat]

Kodları dosyanızın modülüne yapıştırıp butonlara atayın çalışacaktır.
Az önce yanlış link (silme linkini) eklemişim, yükleme linki aşağıdadır.
http://s5.dosya.tc/server/9tnz7d/Koprukur_koprusil.rar.html

 

[sakman26]

selam,
dosya ekte..

link : http://s8.dosya.tc/server2/dejkon/KopruTest.xlsx.html

 

[tafababaji]

Yardımlarınız için çok teşekkür ederim.