VERİLERİ YENİ EXCELE AKTARMA MAKROSU

[csncesur]

Ekli listede ödevini yapanlar ve yapmayanlardan oluşan örnek bir listem var. Butona bastığımda ödevini yapmayanların listesini yeni bir excel olarak kaydetmesini istiyorum. Yardımlarınızı bekliyorum teşekkür ederim.

 

[Haluk]

Sub Test()
'   Haluk - 06/02/2022
    Set Db = CreateObject("DAO.DBEngine.120").OpenDatabase(ThisWorkbook.FullName, False, False, "Excel 8.0; HDR=YES;")
    strSQL = "Select [ADI], [SOYADI] From [PROJE$] Where [ÖDEVİNİ YAPTI MI]='YAPMADI' "
    Set RS = Db.OpenRecordset(strSQL)
    
    Set newWB = Workbooks.Add
    newWB.Sheets(1).Range("A1:B1") = Array("ADI", "SOYADI")
    newWB.Sheets(1).Range("A2").CopyFromRecordset RS
    newWB.SaveAs ThisWorkbook.Path & "\OdevYapmayanlar.xlsx"
    RS.Close
    Db.Close
End Sub

.

 

[csncesur]

Hocam çok teşekkür ederim tam istediğim buydu emeğinize sağlık