Visual Basic makro hatası

Aşağıda vermiş olduğum makroda değişik renkli olarak işaretlediğim satırda ki ifadede çalışma durmakta
tamemen kaldırdığımda ise makro gereğini yaptığı halde bulduğu neticeleri Sonuç sahifesine yazmamaktadır.Bu konuda yardımlarınızı rica ediyorum saygılarımla
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
    Dim MyPath As String
    Dim j As Integer, DataCount As Long, RecCount As Long
    Dim tStart As Double, tEnd As Double
   
    tStart = Timer
    MyPath = "C:\Sonuclar"
   
    If Dir(MyPath, vbDirectory) = Empty Then
        MsgBox MyPath & " dizini bulunamadı, kontrol edin...!", vbCritical, "Dikkat !"
        Exit Sub
    End If
   
    On Error Resume Next
        Set daoDBEngine = CreateObject("DAO.DBEngine")
        Set daoDBEngine = CreateObject("DAO.DBEngine.36")
    On Error GoTo 0
   
    MyFile = Dir(MyPath & "\*.xls", vbDirectory)
    NoA2 = Sheets("Sonuc").Cells(65536, 1).End(xlUp).Row + 1
    Sheets("Sonuc").Range("A2:L" & NoA2).Clear
   
    Do While MyFile <> ""
        If MyFile = ThisWorkbook.Name Then GoTo ResumeSub:
        j = j + 1
        NoA1 = Sheets("Liste").Cells(65536, 1).End(xlUp).Row + 1
        KapDosya = MyPath & "\" & MyFile
        Set DB = daoDBEngine.OpenDatabase(KapDosya, False, False, "Excel 8.0; HDR=Yes; IMEX=1;")
        NoA2 = Sheets("Sonuc").Cells(65536, 1).End(xlUp).Row + 1
       
        Set RS = DB.OpenRecordset("select ` ADI` from [VeriTabanı$]")
            RS.MoveFirst
            RS.MoveLast
            DataCount = DataCount + RS.RecordCount
        RS.Close
       
        For i = 1 To NoA1 - 1
            Set RS = DB.OpenRecordset("select * from [VeriTabanı$] where ` ADI` = '" & Sheets("Liste").Cells(i, 1).Text & "' and `CİNS` = '" & Sheets("Liste").Cells(i, 2).Text & "'")
            NoA2 = Sheets("Sonuc").Cells(65536, 1).End(xlUp).Row + 1
            If RS.RecordCount > 1 Then
                RS.MoveFirst
                RS.MoveLast
            End If
            Sheets("Sonuc").Range("A" & NoA2).CopyFromRecordset RS
            RecCount = RecCount + RS.RecordCount
            RS.Close
        Next
       
ResumeSub:
        MyFile = Dir
        DB.Close
    Loop
   
    tEnd = Timer
   
    MsgBox "İşlem tamam..." & vbCrLf & vbCrLf _
           & "Toplam " & j & " adet dosyada " & Format(DataCount, "#,###") & " adet veri taranarak, " _
           & RecCount & " adet sonuç " & vbCrLf _
           & Format((tEnd - tStart), "#0.00") & " saniye içinde bulundu.", vbInformation, "Sonuç..."
   
    Set RS = Nothing
    Set DB = Nothing
    Set daoDBEngine = Nothing
End Sub