Onay kutusu ile fiyat çağıma

[zaruri]

Değerli Hocalarım;
Onay kutusu seçildiğinde "toplam" fiyat "bakım-onarım" hücresine gelmesi için çalıştım.
Araştırdım, uğraştım beni aştığını fark ettim ve ilgilerinizi bekliyorum.

 

[Muzaffer Ali]

Merhaba.
Onay kutusu yerine hücreye çift tıklama ile yapılabilir. Aksi halde her satır için onay kutusu eklenmesi gerekiyor bu çok uzun iş.
Aşağıdaki kodu sayfanın kod kısmına kopyalayın.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("C:H")) Is Nothing Then
        Cancel = True
        If Cells(Target.Row, "H") = 0 Then
            Cells(Target.Row, "H") = Cells(Target.Row, "G")
        Else
            Cells(Target.Row, "H") = 0
        End If
    End If
End Sub

C ile H kolonarı arasına çift tıkladığınızda istediğiniz işlem gerçekleşecektir.

 

[zaruri]

Değerli Muzaffer Ali, Zaten Böylesi bir kullanıcı dostu bir fikir bekliyordum sizlerden.

İlginize teşekkür ederim, Sağ olun var olun.

 

[Muzaffer Ali]

Teşekkürler. İyi çalışmalar.

 

[zaruri]

Bu işlemlerden sonra;
Onaylanan satırları sırasıyla ana sayfaya gönderebilir ve
sonrasında onayları temizleyebilir miyiz?

 

[zaruri]

Değerli Hocalarım;
Forumdaki çalışmalardan toparlananlar ile çalışma belli bir seviyeye geldi.
Seçimler aktarılıyor, fakat renk ve karakterlerle beraber aktarılıyor, sadece yazılar aktarılsa daha iyi olacak.

Önemlisi; Aktarma satırını "ANASAYFA" "B9" dan başlatamadım.
Boş gördüğü en son sayfadan başlıyor.

Bu konuda yardımlarınızı bekliyorum.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B:I")) Is Nothing Then
Cancel = True
If Cells(Target.Row, "I") = 0 Then
Cells(Target.Row, "I") = Cells(Target.Row, "H")
Else
Cells(Target.Row, "I") = 0
End If
End If

Dim Son As Long, _
Sh2 As Worksheet

Set Sh2 = Sheets("ANASAYFA")

Son = Sh2.Cells(Rows.Count, "B").End(3).Row + 1

Range("B" & Target.Row & ":H" & Target.Row).Copy Sh2.Cells(Son, "B")

Set Sh2 = Nothing

End Sub

 

[Muzaffer Ali]

Fiat sayfasındaki kodları aşağıdakilerle değiştirin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Son As Long
    Dim syfAna As Worksheet
    Dim Bak As Long
    If Not Intersect(Target, Range("B:I")) Is Nothing Then
        Cancel = True
        If Cells(Target.Row, "I") = 0 Then
            Cells(Target.Row, "I") = Cells(Target.Row, "H")
        Else
            Cells(Target.Row, "I") = 0
        End If
    End If
    Set syfAna = Sheets("ANASAYFA")
    Son = syfAna.Cells(26, "B").End(3).Row + 1
    Range("B" & Target.Row & ":H" & Target.Row).Copy
    syfAna.Cells(Son, "B").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Set syfAna = Nothing
End Sub

 

[zaruri]

Hocam; İlginize çok teşekkür ederim,
Formül bilemediğim için gözlerim hala başlama satırı "B9" arıyor.
Emeğinize sağlık.

 

[zaruri]

Değerli Hocalarım;
Çalışma ilerledikçe, yeni sorulara yeni cevaplar geliyor ve beni zorluyor.
Ciddi anlamda arayıp taradıktan sonra sizleri rahatsız ediyorum.

İstenilen satırlar çift tıklama ile ana sayfaya gidiyor.
Fakat işi bilmeyen bir elemanın yapılacak işleri tek tek seçmesinin riskli olacağı düşünülerek,

Gruplar haline getirilen satırları birleştirilmiş hücre ile gruplara dahil edilen satırların tamamını ana sayfaya göndermenin bir yolu var mıdır.
Örnek dosyada konu daha açık olarak görünmektedir.

İlginizi bekler şimdiden teşekkür ederim.