Bir hucredeki veriye çift tıklayarak sabit başka bir hücreye kopyalama

[cevrens]

Merhaba arkadaslar,

Birkac gundur ustunde calıstıgım kapsamlı bir tablom için hem fonksiyon ve hemde makro sorularıma istedigim cevapları alabildigim için herkese tekrar teşekkürler, tablodan son bir kesit gonderiyorum ekte.

Ara bir analiz yapabilmek A sutunundaki yeşil renkli listeden herhangi bir hücreye çift tıklama suretiyle bu hücrenin silinmeden ''A2'' hücresine kopyalanmasına ugrasıyorum. Asagidaki formul ile basladım ama hucreyi tıklayınca siliyor ve sagına taşıyor ,ben sabit olarak ''A2'' hucresine tasımasını ve silinmemesini istiyorum.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, [A9:A1000]) Is Nothing Then
Target.Offset(0, -1).Value = Target.Value
Target.Value = ""
End If
End Sub


Yardımınız icin simdiden tesekkurler.

 

[ÖmerBey]

Deneyiniz...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, [A10:A24]) Is Nothing Then
  Range("A2").Value = Target.Value
End If
End Sub

 

[cevrens]

Deneyiniz...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, [A10:A24]) Is Nothing Then
  Range("A2").Value = Target.Value
End If
End Sub

Tesekkurler,silinmeyi engelledik ama A2 hucresine sabit yazdırma konusunda nasıl yaparız, suan hucreye cift tıklandıgında 0,-1 oldugu icin satırın soluna yazıyor. A Kolonundaki herhangi bir yesil hucreye tıklandıgında ,sabit A2 hucresine kopyalanmasını nasıl yapabiliriz ?

 

[ÖmerBey]

Sorunuzun o kısmını sonradan farkettim ve mesajı düzenledim...
Ancak geç kalmışım anlaşılan. Çözüm yukarıdaki mesajda...
Kodunuzu yukarıdaki ile değiştiriniz.

 

[cevrens]

Cok tesekkurler,gec kalmak ne demek.. benim bircok tablomu rahatlatacak yardımlarınız oluyor sizin ve ustadlarımızın. hem benzer ornekleri kendim turetebiliyorum hemde excel ve makroda ufkum genisliyor,insallah daha cok soru ve yardımla bu isi ileri seviyeye tasıyacagız.
Tekrar tesekkurler..

 

[ÖmerBey]

Rica ederim, yardımcı olabiliyorsak ne mutlu.
İyi akşamlar, iyi çalışmalar...

 

[cevrens]

Rica ederim, yardımcı olabiliyorsak ne mutlu.
İyi akşamlar, iyi çalışmalar...

Hocam kusura bakmayın yine rahatsız ediyorum ama ekte duzenlemesini gonderiyorum aynı sayfada bi liste daha var artık. (H10:H24) satırları arasındaki yine aynı kosulu saglayacak sekilde cift tıklama ile A2 ye yazacak, 2.makro olarak yaptım ama tepki vermedi,hatta 1.yi de bozuyor.
Hatam nerde acaba,yada her ikisini nasıl birlestiririm. Her iki listededen birinde herhangi bir hucereye cift tıkladıgında A2 ye kopyalama.

Cok tesekkurler.

 

[ZorBey_]

Böyle denermisiniz.
If Not Intersect(Target, [A10:A500,H10:H500]) Is Nothing Then

 

[cevrens]

Böyle denermisiniz.
If Not Intersect(Target, [A10:A500,H10:H500]) Is Nothing Then

Cok tesekkurler Hocam.

 

[7xlarge]

Merhaba,
Bu kodu, başka sayfadaki hücreye uyarlayabilir miyiz? Sayfa2 d1 hücresine gibi.

Teşekkürler
İyi Çalışmalar

 

[7xlarge]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("k2:k1000")) Is Nothing Then
Cancel = True
Target.Copy Destination:=Sheets("Extre").Cells(1, 4)
sayfa = Target.Cells.Value
Sheets("Extre").Select

End If

End Sub