otomatik Link verme olayında

[tahsinanarat]

Ekli dosyamda, linkler sayfamda belirtmiş olduğum resim dosyamdaki resimlerin isimlerini a sutununa getirip otomatik olarak link vermekte, Liste adlı sayfamda ise a sutununda bulunan isimler linkler adlı sayfamdaki a sutununda bulunan linklerle eşleşiyor ise liste adlı sayfamdaki link güncelle butonuna basmak suretiyle otomatik olarak link vermektedir. Buraya kadar herşey tamam.

Ancak liste adlı sayfamda z1, z2, z3, z4 gibi buji isimleri linkler adlı sayfamda fotoğrafların linki bulunmadığı halde burada bulunan GADBEYAZ1, GADBEYAZ2, GADBEYAZ3, GADBEYAZ4 gibi başka parçalara ait kod isimlerinde "z1", "z2", "z3", "z4" vs. gibi benzer harflarin bulunmasından dolayı GADBEYAZ... isimli parça fotograflarına link vermektedir.

Benim istediğim linkler sayfamdaki isimler ile liste adlı sayfamdaki isimlerin birebir eşleşmesi halinde link vermesini sağlamak istiyorum. (farklı parçaya ait resmi açmaması için)
Bunun için mevcut olan

Sub kopyala()
On Error Resume Next
Dim s1 As Worksheet, s2 As Worksheet
Dim a As Range
Set s1 = Sheets("Liste")
Set s2 = Sheets("Linkler")
For i = 2 To s1.[A1].End(xlDown).Row
Set a = s2.Cells.Find(Cells(i, 1))
If Not a Is Nothing Then
a.Copy
s1.Cells(i, 1).Select
ActiveSheet.Paste
End If
Next
Range("A2").Select
End Sub
(not kodlar janveljan adlı arkadaşımıza aittir)
kodlarda nasıl bir değişiklik yapmalıyız ki istediğim gibi bire bir eşleşerek link vermesini sağlayabilelim.
Şimdiden ilgilenen arkadaşlarıma teşekkür ediyorum.

 

[Levent Menteşoğlu]

Tahsin bey aşağıdaki gibi denermisiniz.

Sub kopyala()
On Error Resume Next
Dim s1 As Worksheet, s2 As Worksheet
Dim a As Range
Set s1 = Sheets("Liste")
Set s2 = Sheets("Linkler")
For i = 2 To s1.[A1].End(xlDown).Row
If WorksheetFunction.CountIf(s2.[a:a], s1.Cells(i, 1)) = 0 Then GoTo 10
Set a = s2.Cells.Find(Cells(i, 1))
If Not a Is Nothing Then
a.Copy
s1.Cells(i, 1).Select
ActiveSheet.Paste
End If
10 Next
Range("A2").Select
End Sub

 

[tahsinanarat]

Sn. Levent Menteşoğlu, elinize sağlık tam istediğim gibi oldu, çok teşekkür ederim, çok uğraştım ama becerememiştim, şimdi her iki kodu inceleyerek öğrenmeye çalışacağım. Tekrar sağolun. Saygılar.