Soru Hücre Yerine Sütun Belirtme

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,518
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
Es Selamün Aleyküm.

Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sayfa As String
If Not Intersect(Target, Range("B6:B130")) Is Nothing Then
sayfa = "Zati Muhammen Bedel"
Else
Exit Sub
End If

sayfa = "SD"
-----
sayfa = "Zarf Açma"
------
sayfa = "Onay Belgesi"
-------
gibi sayfa adları devam etmekte.
sayfa = "Şartname"
Sheets("Şartname").Range("c9") = Sheets("YM").Range("B6") kodunda hücre değil sütun aralığı seçmek istiyorum.

Şartname C9:C23 aralığına YM sayfasında B6:B130 aralığında hangi hücreye çift tıklarsam aktarmasını nasıl sağlayabilirim.

Teşekkür eder, saygılarımı sunarım.
 

yanginci34

Altın Üye
Katılım
6 Temmuz 2010
Mesajlar
1,627
Excel Vers. ve Dili
excel2016
Altın Üyelik Bitiş Tarihi
12-10-2026
Merhaba örnek dosya eklermisiniz.
 

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,518
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
Üstad dosya ekli

YM sayfasında B6 : B130 arasında istenilen bir satıra (okul adına) çift tıklandığı zaman

YM sayfasında ki B sütunu Şartname sayfasında ki C sütununa
YM sayfasında ki D sütunu Şartname sayfasında ki D sütununa
YM sayfasında ki E sütunu Şartname sayfasında ki E sütununa
YM sayfasında ki F sütunu Şartname sayfasında ki F sütununa

aktarılmasını istiyorum. Ekli formda da örnek bilgiler aktarılmış şekilde


Yardımcı olabilirseniz memnun olurum.
Teşekkür eder saygılarımı sunarım.


NOT :
VBA kod sayfasında ki kodlar asıl dosyada çalışmaktadır.
 

Ekli dosyalar

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Sayfanızda var olan "BeforeDoubleClick" kodlarını silin, aşağıdaki kodları kopyalayın.

Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim SonSatir As Long
    If Not Intersect(Target, Range("B6:B130")) Is Nothing Then
        With Worksheets("Şartname")
            For SonSatir = 8 To Rows.Count
                If .Cells(SonSatir, "C") = "" Then Exit For
            Next
            .Range("C" & SonSatir).Value = Target.Value
            .Range("D" & SonSatir).Value = Target(1, 2).Value
            .Range("E" & SonSatir).Value = Target(1, 3).Value
            .Range("F" & SonSatir).Value = Target(1, 4).Value
        End With
    Else
        Exit Sub
    End If
End Sub
 

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,518
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
Üstad Diğer kodlar asıl dosyada çalışıyor. Silersem diğer sayfalar çalışmaz
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
O zaman bu kodları en üste kopyalayın.
 
Üst