hücreye tıklama ile sayfadan diğer sayfaya veri yapıştırma

[BİLİMTEKNİK]

merhabalar
Sayın Ömer Baran hocam mümkünse sizden ricam;
excelde şöyle bir makroya ihtiyacım var
örnek Sayfa1 deki B3 hücresine tıkladığımda Sayfa2 açılsın ve B3 ün değerini (B3=456) Sayfa2 deki R15 şe yapıştırsın.
şimdiden teşekkürler...

 

[Korhan Ayhan]

"Sayfa1" isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayınız.

B3 hücresine çift tıklama yaptığınızda istediğiniz işlem olacaktır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub
    Cancel = True
    Sheets("Sayfa2").Activate
    Sheets("Sayfa2").Range("R15") = Target.Value
End Sub

 

[muhasebeciyiz]

"Sayfa1" isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayınız.

B3 hücresine çift tıklama yaptığınızda istediğiniz işlem olacaktır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub
    Cancel = True
    Sheets("Sayfa2").Activate
    Sheets("Sayfa2").Range("R15") = Target.Value
End Sub

sayın korhan bey ;

bu seçenekleri nasıl çoğaltabiliriz şöyleki ;

sizin örnekte B3 hücresine işlem uygulanıyor

biz C4-c5-c6-c7-c8-c9 hücrelerini sayfa2'deki R16-R17-R18-R19-R20-R21 hücrelerini bağ olarak yapıştırması için ne yapabiliriz.

Saygılar

 

[Korhan Ayhan]

Aşağıdaki gibi deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Set Alan = Range("C4:C9")
    If Intersect(Target, Alan) Is Nothing Then Exit Sub
    Cancel = True
    Alan.Copy
    Sheets("Sayfa2").Activate
    Sheets("Sayfa2").Range("R16").Activate
    Sheets("Sayfa2").Paste Link:=True
    Sheets("Sayfa2").Range("A1").Activate
    Application.CutCopyMode = False
End Sub

 

[muhasebeciyiz]

Aşağıdaki gibi deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Set Alan = Range("C4:C9")
    If Intersect(Target, Alan) Is Nothing Then Exit Sub
    Cancel = True
    Alan.Copy
    Sheets("Sayfa2").Activate
    Sheets("Sayfa2").Range("R16").Activate
    Sheets("Sayfa2").Paste Link:=True
    Sheets("Sayfa2").Range("A1").Activate
    Application.CutCopyMode = False
End Sub

Sayın Korhan hocam ;
Sizden ricam olacak şöyleki ;

Sayfa1'deki C4 ile E16 arasındaki hücrelere giriş yapmaktayım.
Bu bilgileri Sayfa2'deki hücrelere bağ olarak yapıştırmak istiyorum.

C4 hücresindeki bilgi Sayfa2'deki BT 29 hücresine
C5 hücresindeki bilgi Sayfa2'deki BT 30 hücresine
C6 hücresindeki bilgi Sayfa2'deki BT 31 hücresine
C7 hücresindeki bilgi Sayfa2'deki BT 32 hücresine
C8 hücresindeki bilgi Sayfa2'deki BT 33 hücresine
C9 hücresindeki bilgi Sayfa2'deki BT 34 hücresine
C10 hücresindeki bilgi Sayfa2'deki BT 35 hücresine
C11 hücresindeki bilgi Sayfa2'deki BT 36 hücresine
C12 hücresindeki bilgi Sayfa2'deki BT 37 hücresine bağ olarak yapıştırılacaktır.

D4 hücresindeki bilgi Sayfa2'deki CN 29 hücresine
D5 hücresindeki bilgi Sayfa2'deki CN 30 hücresine
D6 hücresindeki bilgi Sayfa2'deki CN 31 hücresine
D7 hücresindeki bilgi Sayfa2'deki CN 32 hücresine
D8 hücresindeki bilgi Sayfa2'deki CN 33 hücresine
D9 hücresindeki bilgi Sayfa2'deki CN 34 hücresine
D10 hücresindeki bilgi Sayfa2'deki CN 35 hücresine
D11 hücresindeki bilgi Sayfa2'deki CN 36 hücresine
D12 hücresindeki bilgi Sayfa2'deki CN 37 hücresine bağ olarak yapıştırılacaktır.

E4 hücresindeki bilgi Sayfa2'deki DK 29 hücresine
E5 hücresindeki bilgi Sayfa2'deki DK 30 hücresine
E6 hücresindeki bilgi Sayfa2'deki DK 31 hücresine
E7 hücresindeki bilgi Sayfa2'deki DK 32 hücresine
E8 hücresindeki bilgi Sayfa2'deki DK 33 hücresine
E9 hücresindeki bilgi Sayfa2'deki DK 34 hücresine
E10 hücresindeki bilgi Sayfa2'deki DK 35 hücresine
E11 hücresindeki bilgi Sayfa2'deki DK 36 hücresine
E12 hücresindeki bilgi Sayfa2'deki DK 37 hücresine bağ olarak yapıştırılacaktır.

mümkün olursa teşekkür ediyorum.

 

[Korhan Ayhan]

Deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("C4:E12")) Is Nothing Then Exit Sub
    Cancel = True
    Select Case Target.Column
        Case 3: Kaynak = "C": Hedef = "BT"
        Case 4: Kaynak = "D": Hedef = "CN"
        Case 5: Kaynak = "E": Hedef = "DK"
    End Select
    Range(Kaynak & "4:" & Kaynak & "12").Copy
    Sheets("Sayfa2").Activate
    Sheets("Sayfa2").Range(Hedef & "29").Activate
    Sheets("Sayfa2").Paste Link:=True
    Sheets("Sayfa2").Range("A1").Activate
    Application.CutCopyMode = False
End Sub

 

[muhasebeciyiz]

Deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("C4:E12")) Is Nothing Then Exit Sub
    Cancel = True
    Select Case Target.Column
        Case 3: Kaynak = "C": Hedef = "BT"
        Case 4: Kaynak = "D": Hedef = "CN"
        Case 5: Kaynak = "E": Hedef = "DK"
    End Select
    Range(Kaynak & "4:" & Kaynak & "12").Copy
    Sheets("Sayfa2").Activate
    Sheets("Sayfa2").Range(Hedef & "29").Activate
    Sheets("Sayfa2").Paste Link:=True
    Sheets("Sayfa2").Range("A1").Activate
    Application.CutCopyMode = False
End Sub

Sevgili hocam sadece ilk sutun bağ yapışmakta geri kalan çalışmamaktadır.

Hocam bir zahmet size doble klik olayını kaldırıverelim çünki her hücreye ayrı ayrı tıklamak baya zor işmiş.
Kod çalışınca bir seferde bağ yapıştırıversin.

Dosyayı ekliyorum.Yardımcı Olursanız sevinirim.Hayırlı cumalar.

 

[BİLİMTEKNİK]

korhan bey yeni üye ve amatör olduğum için örnek dosya gönderme işlemini yapamadım tekrar deneyeceğim.
not :hücreye tıklayınca sayfadan diğer sayfaya veri aktarma başlığıma cevap olarak siz bana aşağıdaki kodu gönderdiniz.Bugün ki iki ricam dan birincisi gönderdiğiniz bu kod içine ilave
çünkü ilk mesajım da bunu yazmamışım.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub
Cancel = True
Sheets("Sayfa2").Activate
Sheets("Sayfa2").Range("R15") = Target.Value
End Sub