• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

double click ile iki sütundaki hücreleri bir satıra aktarma

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,545
Excel Vers. ve Dili
2021 LTSC TR
Selamün Aleyküm.

Değerli Arkadaşlarım,
H6:H26 ve I6:I26 sütunlarında veri mevcut.
Yapmak istediğim şu:
H6:H26 sütunundan herhangi birine çift tıkladığımda tıkladığım hücredeki veriyi
I6:I26 sütununda ki çift tıkladığım hücredeki veri ile birleştirerek B1 hücresine aktarmak istiyorum.

Yardımcı olabilir misiniz?

Teşekkür eder, saygılarımı sunarım
 
Aleykum Selam,
Aşağıdaki kodu igili sayfanın kod bölümüne kopyalayınız.
Arada boşluk istemiyorsanız kırmızı kısmı silin.
Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("H6:H26")) Is Nothing Then Exit Sub
If Target <> "" Then Range("B1") = Target.Value [COLOR="Red"]& " "[/COLOR] & Target.Offset(0, 1).Value: Cancel = True
End Sub
 
Merhaba.
Önce H sütunundaki alana ardından I sütunundaki ilgili alana çift tıklayacağınız varsayımıyla,
aşağıdaki kod'u sayfanın kod bölümüne (sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan ekranın sağ tarafına) yapıştırın.
Sanırım istediğiniz böyle bir şey.
Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [H6:H26, I6:I26]) Is Nothing Then Exit Sub
    If Target.Column = 8 Then
        Cells(1, 2) = Target
    End If
        If Target.Column = 9 And Cells(1, 2) <> "" Then
            Cells(1, 2) = Cells(1, 2) & " " & Target
        End If
End Sub
İlave Not: Sayın mucit cevap yazmış bile.
 
Ömer Bey'in cevabından sonra sorunuzu yeniden okudum, yanlış anlamışım galiba...
Yukarıda anlattığınız isteğe göre Ömer Bey'in yazdığı kod daha doğru olur.
Bu da alternatifi olsun:
Kod:
Dim ilk As Range
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("H6:H26")) Is Nothing Then
    If Target <> "" Then Set ilk = Target: Cancel = True
ElseIf Not Intersect(Target, Range("I6:I26")) Is Nothing And Not ilk Is Nothing Then
    Range("B1").Value = ilk.Value & " " & Target.Value: Cancel = True
Else
    Set ilk = Nothing
End If
End Sub
 
Son düzenleme:
Ömer BARAN ve mucit77 arkadaşlarıma yardımlarını esirgemedikleri için teşekkür ederim.
İyi ki varsınız.
 
Geri
Üst