vba yardım

[mserler]

iyi akşamlar.aşağıdaki kod un verdiği hatayı bir türlü düzeltemedim.yardım edebilirmisiniz?kırmızı yazıda hata veriyor.

Private Sub CommandButton1_Click()
Dim DB As Object
Dim RS As Object
Dim dbRow As Long
Dim KapDosya As Variant
Dim i As Long, NoA1 As Long, NoA2 As Long

NoA1 = Sheets("Liste").Cells(300000, 1).End(xlUp).Row + 1


KapDosya = ThisWorkbook.FullName

On Error Resume Next
Set daoDBEngine = CreateObject("DAO.DBEngine")
Set daoDBEngine = CreateObject("DAO.DBEngine.36")
On Error GoTo 0

Set DB = daoDBEngine.OpenDatabase(KapDosya, False, False, "Excel 8.0; HDR=Yes; IMEX=1;")

NoA2 = Sheets("Sonuc").Cells(300000, 1).End(xlUp).Row + 1

Sheets("Sonuc").Range("A2:L" & NoA2).Clear

For i = 1 To NoA1 - 1
Set RS = DB.OpenRecordset("select * from [VeriTabanı$] where `ATIN ADI` = '" & Sheets("Liste").Cells(i, 1).Text & "'")

With RS
.MoveLast
dbRow = .RecordCount
.MoveFirst
End With

NoA2 = Sheets("Sonuc").Cells(300000, 1).End(xlUp).Row + 1

Sheets("Sonuc").Range("A" & NoA2).CopyFromRecordset RS

RS.Close
Next

DB.Close

MsgBox "İşlem tamam...", vbInformation, "Sonuç..."

Set RS = Nothing
Set DB = Nothing
Set daoDBEngine = Nothing
End Sub