Soru Çift tıklama ile aktar

[mcetinkaya65]

I 13 den I 35 e kadar olan hücrelere yazılan verilerden
Çift tıklanan hücredeki veriyi B4 hücresine eski veriyi silerek yeni veriyi aktarması mümkün mü?

Saygılarımla...

 

[BAZGİRET]

Bu şekilde mi

 

[mcetinkaya65]

Bu şekilde mi

Üstad çift tıkladığımız veri karşıya atıyor ama çift tıklanan hücrelerdeki verileri siliyor.

 

[BAZGİRET]

Üstad çift tıkladığımız veri karşıya atıyor ama çift tıklanan hücrelerdeki verileri siliyor.

O zaman soruyu biraz daha detaylandırın. Konu yanlış anlaşılmış olabilir.
Ya da şu satırı silin

 Target.Value = ""

 

[Seyit Tiken]

Bu şekilde deneyiniz.

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [I13:I35]) Is Nothing Then Exit Sub
Cancel = True
[B4] = Target
End Sub

 

[mcetinkaya65]

İlginize Teşekkür ederim.
Allah Razı olsun.

 

[baydeniro]

Bu şekilde deneyiniz.

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [I13:I35]) Is Nothing Then Exit Sub
Cancel = True
[B4] = Target
End Sub

Teşekkürler üstad, sayenizde yeni bir şey öğrenmiş olduk.

 

[Korhan Ayhan]

Deneyiniz.

"I" sütununa çift tıkladığınızda istediğiniz hücreler aktarılır.

Option Explicit

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, [I:I]) Is Nothing Then Exit Sub
    Cancel = True
    Range("B4").Resize(, 8).Value = Target.Resize(, 8).Value
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, [I17:I21]) Is Nothing Then Exit Sub
    Cancel = True
    Target.Resize(, 8).Value = Range("B4").Resize(, 8).Value
End Sub

 

[Korhan Ayhan]

Bu işlemi hangi hücre aralığında istiyorsunuz?

 

[Korhan Ayhan]

Mesajınızda ki satır aralığına göre hücreler arasında 24 satır var. Kodu buna göre düzenledim. Siz kendi çalışmanıza uyarlarsınız.

Option Explicit

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("K25:K" & Rows.Count)) Is Nothing Then Exit Sub
    Cancel = True
    Target.Resize(, 7).Value = Target.Offset(-24).Resize(, 7).Value
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("K25:K" & Rows.Count)) Is Nothing Then
        Cancel = True
        Target.Resize(, 7).Value = Target.Offset(-24).Resize(, 7).Value
    ElseIf Not Intersect(Target, Range("DE:DE")) Is Nothing Then
        Cancel = True
        Target.Resize(, 31).Value = Range("DD37").Resize(, 31).Value
    End If
End Sub

 

[Korhan Ayhan]

Mesajımı revize ettim.

Siz ilgili bölümde noktalı virgül kullanmışsınız. Ben de o bölüme dikkat etmedim. Şimdi düzelttim. Yeniden deneyiniz.

 

[kayserciyes]

Deneyiniz.



Ekli dosyayı görüntüle 226251

Bu makroda çift tık

Deneyiniz.

"I" sütununa çift tıkladığınızda istediğiniz hücreler aktarılır.

Option Explicit

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, [I:I]) Is Nothing Then Exit Sub
    Cancel = True
    Range("B4").Resize(, 8).Value = Target.Resize(, 8).Value
End Sub

Bu makro I:I sutününda çift tıklayınca B4 e kopyalıyor

1- Burada kopyalamayı her çift tıklandığında B4 ün üzerine onu değiştirerek değil de
B4 den aşağıya doğru boş olan yere eklenerek kopyalanmasını sağlaya bilir miyiz

(birinci çift tıklama da B4 ikinci çift tıklamada B5 üçte B5 sonra yanlış olduğunu fark ettim B5 sildim sonra ki tıklamada ilk boş yer b5 olduğu için B5 e kopyalayabilirmi)


Yardımcı olursanız sevinirim