checkbox ile sayfalar arasında veri aktarma

[HARUND]

Arkadaşlar herkeses iyi akşamlar forumun yeni üyelerindenim yaklaşık 1 haftadır uğraştığım bir taslak var. Forumda da epey incelememe rağmen istediğim türden bir çalışma örneğine rastlayamadım.amacım çek & senet takibi yapabilmek.burada dosyada da görüleceği gibi belirli alanları oluşturdum örnek olarak cboxta koydum tabi kod yazmayı bilmediğim için sayfalar arası aktarım kısmını tamamlayamadım. Sizlerden ricam dosyayı inceleyip aşağıda maddelendirdiğim özelliklere göre dosyayı düzenleyebilirmisiniz eminim benim dışımdaki kullanıcıların da işine yarayacak bir çalışma olacaktır.ilgilenen herkese şimdiden teşekkürler
yapmaya çalıştıktılarım
-öncelikle can alıcı nokta ilk sayfada görünen cbox ile işaretlenmiş satırın aktarılacak sayfadaki satıra sırayla aktarılabilmesini sağlamak
-aktarım yapılan satır diğer sayfada da filtre özelliğini kaybetmemeli yani vade,çek no,firma gibi bilgiler aktarılan sayfadaki ilgili satırlarla bire bir örtüşmeli

 

[Korhan Ayhan]

Selamlar,

Bu işlem için bence CheckBox kullanmanıza gerek yok.

Aşağıdaki kodu ALINAN ÇEKLER sayfasının kod bölümüne uygulayınız. F-G-H sütunlarındaki hücrelere çift tıkladığınızda veriler ilgili sayfalara aktarılacaktır. Sütun yerlerini kendinize göre değiştirebilirsiniz.

Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, SATIR As Long
 
    If Intersect(Target, [F:H]) Is Nothing Then Exit Sub
 
    If Target.Row > 1 Then
 
    Cancel = True
 
    Select Case Target.Column
        Case Is = 6
        Set S1 = Sheets("İŞBANKASI'NA VERİLEN ÇEK&SENET")
        SATIR = S1.Range("A65536").End(3).Row + 1
        S1.Cells(SATIR, 1) = Cells(Target.Row, 1)
        S1.Cells(SATIR, 2) = Cells(Target.Row, 2)
        S1.Cells(SATIR, 3) = Cells(Target.Row, 4)
        S1.Cells(SATIR, 4) = Cells(Target.Row, 5)
        S1.Cells(SATIR, 5) = "İŞ BANKASI"
        S1.Cells(SATIR, 6) = Cells(Target.Row, 3)
 
        Case Is = 7
        Set S2 = Sheets("Y.KREDİYE VERİLEN ÇEK&SENET")
        SATIR = S2.Range("A65536").End(3).Row + 1
        S2.Cells(SATIR, 1) = Cells(Target.Row, 1)
        S2.Cells(SATIR, 2) = Cells(Target.Row, 2)
        S2.Cells(SATIR, 3) = Cells(Target.Row, 4)
        S2.Cells(SATIR, 4) = Cells(Target.Row, 5)
        S2.Cells(SATIR, 5) = "YAPI KREDİ BANKASI"
        S2.Cells(SATIR, 6) = Cells(Target.Row, 3)
 
        Case Is = 8
        Set S3 = Sheets("CİRO EDİLEN  ÇEKLER")
        SATIR = S3.Range("A65536").End(3).Row + 1
        S3.Cells(SATIR, 1) = Cells(Target.Row, 1)
        S3.Cells(SATIR, 2) = Cells(Target.Row, 2)
        S3.Cells(SATIR, 3) = Cells(Target.Row, 4)
        S3.Cells(SATIR, 4) = Cells(Target.Row, 5)
        S3.Cells(SATIR, 5) = "CİRO EDİLEN ÇEK"
        S3.Cells(SATIR, 6) = Cells(Target.Row, 3)
    End Select
 
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
 
    End If
End Sub

 

[HARUND]

Teşekkürler

Hocam ilginize teşekkür ederim emeğinize sağlık çok şık bir çalışma olmuş bu belge üzerinden bir ajanda bağlantısı yapmayı düşünüyorum eğer becerebilirsem evrakların vadesi gelmeden 2 gün önce wındows takvim programını otomatik olarak açarak ekrana hatırlatma mesajı göndermesini deneyeceğim eğer olmazsa sizi tekrar rahatsız ederim tekrar teşekkürler iyi günler