Şarta Göre Diğer sayfaya Satır Aktarmak

[zaruri]

Değerli Hocalarım;

Diğer örneklere baktım, Fakat bir türlü uyarlama yapamadım.
Oysa Yıllardır Emek verilmiş, uygulamalardan istifade ederek yol yürüdüm.

Ek de, bulunan çalışmada;

"Geldi" ve "Emanette" satırlarından; "Emanette" olanları 2. sayfaya (emanette) taşımak istiyoruz.
Bordro sayfası her ay yenileniyor ve Emanette kalanlar oluyor, yenilenen ayların emanette kalanları için
2. sayfaya boş satırdan itibaren taşınması gerekiyor.

İyi çalışmalar dileğiyle ilgilerinizi beklerim.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Aktar()
    Dim Baglanti As Object, Kayit_Seti As Object
    Dim Sorgu As String, Kontrol As Boolean, Zaman As Double
    
    Zaman = Timer
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Sorgu = "Select F2,F3,F4,F5,F6,F7 From [BORDRO$B5:I] Where F1 = 'Emanette' And IsNull(F8)"
    
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    
    If Kayit_Seti.RecordCount > 0 Then
        Sheets("EMANETTE").Cells(Rows.Count, "C").End(3)(2, 1).CopyFromRecordset Kayit_Seti
        Kontrol = True
    End If
    
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    
    
    Sorgu = "Select IIf(F1 = 'Emanette','X','') From [BORDRO$B5:I]"
    
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    
    If Kayit_Seti.RecordCount > 0 Then
        Sheets("BORDRO").Range("I5").CopyFromRecordset Kayit_Seti
    End If
    
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close

    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    
    If Kontrol Then
        MsgBox "İşleminiz tamamlanmıştır." & vbCr & vbCr & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Aktarılacak kayıt bulunamadı!", vbExclamation
    End If
End Sub

 

[zaruri]

Hocam, Sizlerin çok emeği geçti, Hakkınızı helal ediniz, çok istifade ettim sizlerden.
İlminizin sadakası kabul, makbul ve Hayırlara vesile olsun.

Sağlıcakla Kalın.

 

[Korhan Ayhan]

Öncelikle hakkım varsa helal olsun.

Burada belirtmekte fayda görüyorum.

Aktarım işlemi yapılırken "I" sütununu yardımcı sütun olarak kullandım.

"B" sütunu "Emanette" koşulu olup "I" sütunu boş olan kayıtlar diğer sayfaya aktarılıyor.

Aktarma işleminden sonra aktarılan kayıtların satırlarına "X" yazdırılıyor. Bu ikinci kez aktarım yapılırsa karışıklığı önlemek amacıyla eklediğim bir işlemdir.

"BORDRO" sayfasındaki verilerinizi güncelledikten sonra yeniden aktarım yapmak isterseniz aktarılacak kayıtlara ait "I" sütunundaki satırların boş olmasına dikkat ediniz.

 

[zaruri]

Bilgilendirme için teşekkür ederim, Çalışmaya monte ediyorum, dikkate alacağım.

Eksik Olmayınız.

 

[zaruri]

Değerli Hocam, Ufak bir aksaklık oluştu, çözemedim.
2. aşamada oluşan emanet ve sevkleri görmüyor,
ilk yaptığı işlemi tekrar ediyor.
Çıkışta ise ekte gönderdiğim mesaj veriyor.
İlgilerinizi bekliyoruz.

 

[Korhan Ayhan]

Eğer kod tamamlanmadan yarıda keserseniz dosyaya bağlantı kurulduğu için arka planda dosya açık kalmış gibi görünecektir ve kapanışta o uyarıyı verecektir.

Ben paylaştığınız dosyayı denediğimde bahsettiğiniz sorunları yaşamadım.

 

[zaruri]

Son Denememde çalıştı, Hocam