VBA İlgili Satırı Diğer Sayfaya Kopyalama

Katılım
24 Haziran 2022
Mesajlar
26
Excel Vers. ve Dili
Excel 2016 - Tr
Merhabalar. Örnek dosyada da görüleceği üzere satırın yanına eklediğim onay kutusuna tıklayınca ilgili satır izinli ve kırmızı olarak görünüyor. Onay kutusuna tıkladıktan sonra ilgili hücreleri diğer sayfadaki tabloya kopyalamasını istiyorum. Formülle bir çözüm bulamadığım için vba ile yardımcı olabilirseniz çok sevinirim şimdiden teşekkür ederim.
 

Ekli dosyalar

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,616
Excel Vers. ve Dili
Microsoft 365 Tr-64
Onay kutusunu tıklayıp onayı kaldırınca birşey yapacak mı?
 
Katılım
24 Haziran 2022
Mesajlar
26
Excel Vers. ve Dili
Excel 2016 - Tr
Hocam onayı kaldırdıktan sonra bir işlem yapmasına gerek yok. Benim amacım burada kopyala yapıştır işlemini azaltmak. Personel izinden döndükten sonra izin tablosundan isimleri silmem yeterli olur.
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,616
Excel Vers. ve Dili
Microsoft 365 Tr-64
Onay kutusunu yanlışlıkla tıklama durumunuzda KODLAR tıklanan ismi listeye ekleyecek.
Yanlışı farkedip onayı kaldırınca listeden silinmeyecek mi?
 
Katılım
24 Haziran 2022
Mesajlar
26
Excel Vers. ve Dili
Excel 2016 - Tr
Hocam tekrar tıklayınca listeden kaldırması güzel olur tabi ki açıkçası sizi daha fazla uğraştırmak istemedim :) ama oraya kopyalanan ismin tekrar tıkladıktan sonra kalkması daha güzel olur.
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,616
Excel Vers. ve Dili
Microsoft 365 Tr-64
Sayfanıza buton ya da şekil ekleyin. Aşağıdaki kodu bir modüle içine koyup butona bu makroyu atayın.
Onay butonlarını arzu ettiğiniz gibi işaretledikten sonra butona basın
C++:
Sub izinkaydet()
    Dim DictList As Scripting.Dictionary, Sh As Worksheet, Son As Long, i As Long, k As Byte, KaydedilecekVeri, KayıtlıVeri, Liste()
    Son = Range("B" & Rows.Count).End(3).Row
    If Son < 3 Then MsgBox "Liste boş": Exit Sub
    KaydedilecekVeri = Range("B3:D" & Son).Value
    Set Sh = Worksheets("İZİN")
    Son = Sh.Range("B" & Rows.Count).End(3).Row
    KayıtlıVeri = Sh.Range("B2:D" & Son).Value
    Set DictList = New Scripting.Dictionary
    For i = 2 To UBound(KayıtlıVeri)
        If Not DictList.Exists(KayıtlıVeri(i, 1)) Then DictList.Add KayıtlıVeri(i, 1), KayıtlıVeri(i, 2) & " xx " & KayıtlıVeri(i, 3)
    Next i
    Sh.Range("B3:D" & DictList.Count + 3).ClearContents
    For i = 1 To UBound(KaydedilecekVeri)
        If Not DictList.Exists(KaydedilecekVeri(i, 1)) Then
            If KaydedilecekVeri(i, 3) = "İZİNLİ" Then DictList.Add KaydedilecekVeri(i, 1), KaydedilecekVeri(i, 2)
        Else
            If KaydedilecekVeri(i, 3) <> "İZİNLİ" Then DictList.Remove KaydedilecekVeri(i, 1)
        End If
    Next i
    ReDim Liste(1 To DictList.Count, 1 To 3)
    For i = 1 To DictList.Count
        Liste(i, 1) = DictList.Keys()(i - 1)
        For k = 0 To UBound(Split(DictList.Items()(i - 1), " xx "))
            Liste(i, k + 2) = Split(DictList.Items()(i - 1), " xx ")(k)
        Next k
    Next i
    If DictList.Count > 0 Then Sh.Range("B3:D" & DictList.Count + 2) = Liste
    Set DicList = Nothing: Set Sh = Nothing: Erase KayıtlıVeri: Erase KaydedilecekVeri: Erase Liste
End Sub
 
Katılım
24 Haziran 2022
Mesajlar
26
Excel Vers. ve Dili
Excel 2016 - Tr
Hocam makroyu çalıştırdığımda hata veriyor bir de bunu onay kutusuna tıkladığımda yapması mümkün mü acaba ?
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,616
Excel Vers. ve Dili
Microsoft 365 Tr-64
Excel dosyanızda VBA penceresinde Tools /Reference altında aşağıdaki resimde görülen en alttaki seçeneği Microsoft Scrripting Runtime sizin listeden bulup aktif edin.

237580

Fazladan bir butona basınca daha kararlı oluyor. Aksi durumda farklı bir kod yazmak gerekiyor.
 
Katılım
24 Haziran 2022
Mesajlar
26
Excel Vers. ve Dili
Excel 2016 - Tr
Hocam emeğinize teşekkür ederim öncelikle. Şimdi de şu satırda uyarı veriyor herhangi bir işlem yapmıyor
ReDim Liste(1 To DictList.Count, 1 To 3)
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,616
Excel Vers. ve Dili
Microsoft 365 Tr-64
Sanırım tüm listeyi sıfırladınız.
O satırın hemen üstüne aşağıdaki satırı ilave edin lütfen.
C++:
If DictList.Count = 0 Then Exit Sub
 
Katılım
24 Haziran 2022
Mesajlar
26
Excel Vers. ve Dili
Excel 2016 - Tr
Hocam dediğiniz gibi yaptım fakat atadığım butona tıkladıktan sonra onay kutusunu işaretliyorum oraya herhangi bir kopyalama yapmıyor.
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,616
Excel Vers. ve Dili
Microsoft 365 Tr-64
Önce ONAY TUŞLARI na basın sonra YENİ BUTONA
 
Katılım
24 Haziran 2022
Mesajlar
26
Excel Vers. ve Dili
Excel 2016 - Tr
Hocam çalışıyor çok teşekkür ederim biraz zahmet oldu ama kusuruma bakmayın emeğinize sağlık :)
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,616
Excel Vers. ve Dili
Microsoft 365 Tr-64
Teşekkürler. Kolay gelsin.
 
Üst