Hyperlink ile Değişken Atama

[magritus]

Merhaba,

Bir rapor dosyası için hyperlink verisini değişken olarak atamak istiyorum.

Şöyle ki,
Sheet1 de A1 e bir hyperlink vereyim, ona tıkladığımda A1 e verdiğim değer Sheet2 de A3 hücresine yazılsın ya da bu olmuyorsa,

Sheet1 de A1 e hyperlink tanımlayayım bu değere tıkladığımda mevcut sheet kopyalanıp tıkladığım hyperlink in ismini alsın.

Saygılar,

 

[magritus]

Amacımı özetlemek gerekirse bir liste düşünün, bu listede çeşitli veriler var.
Benim amacım bir sütunun tamamına hyperlink vererek bir tek tık ile içeriği vlookup ile dolu bir rapor oluşturmak.

Sheet2 benim rapor sayfam olacak, Sheet1 e tanımlayacağım Hyperlinkdeki değeri Sheet2 de bir hüceye koyabilirsem eğer bütün sistemim gayet güzel çalışacak.

 

[Merhum İdris SERDAR]

.

Örnek dosya eklerseniz daha çabuk çözüm bulabilirsiniz.

.

 

[magritus]

Örnek dosya ekteki gibidir.

 

[Merhum İdris SERDAR]

.

Amacınızı anlayamadığım için bir şey diyemiyorum.

.

 

[tahsinanarat]

Eğer anladığın doğru ise sayfanın kod bölümüne aşağıdaki kodu yapıştırıp deneyin, sheet1 de seçtiğiniz hücre değeri Sheet2 nin d2 hücresine kopyalar

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

            Dim WordObj As Object
            Selection.Copy
Sheets("sheet2").Range("d2").PasteSpecial
Application.CutCopyMode = False
End Sub

 

[magritus]

Eğer anladığın doğru ise sayfanın kod bölümüne aşağıdaki kodu yapıştırıp deneyin, sheet1 de seçtiğiniz hücre değeri Sheet2 nin d2 hücresine kopyalar

evet bu kabaca işimi gördü çok teşekkür ederim. Peki bu seçilen hücreleri belirli bir range ile sınırlamamız mümkün mü? bu örnekte Sheet1 de range olarak B3:B7 arası seçimlerde sadece çalışsın gibi?

 

[magritus]

evet, soruumu şu method ile çözdüm..
fikir verenlere, okuyup düşünenlere teşekkür ederim.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("B3:B7")) Is Nothing Then

Dim WordObj As Object
Selection.Copy
Sheets("Sheet2").Range("D2").PasteSpecial
Application.CutCopyMode = False
Sheets("Sheet2").Activate

Else
MsgBox "Problem var"
End If
End Sub