Çözüldü Makro Düzenlenmesi

Sub bul()
Dim son1 As Long: son1 = Sheet1.Cells(Rows.Count, "A").End(3).Row
Dim son2 As Long: son2 = Sheet1.Cells(Rows.Count, "M").End(3).Row
Dim son3 As Long: son3 = Sheet2.Cells(Rows.Count, "E").End(3).Row + 1
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheet2.Range("E2:G" & son3).ClearContents

For i = 2 To son1
son3 = Sheet2.Cells(Rows.Count, "E").End(3).Row + 1
If say(Sheet1.Range("N2:N" & son2), Sheet1.Cells(i, "B")) = 0 Then
Sheet2.Cells(son3, "E") = Sheet1.Cells(i, "A").Value
Sheet2.Cells(son3, "F") = Sheet1.Cells(i, "B").Value
Sheet2.Cells(son3, "G") = "2.ci Listede Yok"

End If
Next
For i = 2 To son2
son3 = Sheet2.Cells(Rows.Count, "E").End(3).Row + 1
If say(Sheet1.Range("B2:B" & son1), Sheet1.Cells(i, "N")) = 0 Then
Sheet2.Cells(son3, "E") = Sheet1.Cells(i, "M").Value
Sheet2.Cells(son3, "F") = Sheet1.Cells(i, "N").Value
Sheet2.Cells(son3, "G") = "1.ci Listede Yok"

End If
Next
son3 = Sheet2.Cells(Rows.Count, "A").End(3).Row + 1
    Sheet2.Range("A2:D" & son3).ClearContents
For i = 2 To son1
son3 = Sheet2.Cells(Rows.Count, "A").End(3).Row + 1
If say(Sheet1.Range("N2:N" & son2), Sheet1.Cells(i, "B")) <> 0 Then
Sheet2.Cells(son3, "A") = Sheet1.Cells(i, "A").Value
Sheet2.Cells(son3, "B") = Sheet1.Cells(i, "B").Value
Sheet2.Cells(son3, "C") = Sheet1.Cells(i, "U").Value - Sheet1.Cells(i, "I").Value
Sheet2.Cells(son3, "D") = Sheet1.Cells(i, "K").Value

End If
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False

End Sub
Function say(ByVal userRange As Variant, ByVal userCriteria As Variant)
    say = Application.WorksheetFunction.CountIf(userRange, userCriteria)
End Function

DefObj C, R: DefStr S
Sub Emre()
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
    Application.ScreenUpdating = False
    Sayfa3.Range("A2:D500000").Delete Shift:=xlUp
    sorgu = "SELECT [Tipi1],[Malzeme No1], s2.[Per2],(s2.[Gerçek tarihi2]-[s1.Gerçek tarihi1]) FROM"
    sorgu = sorgu & " [Sayfa1$] as s1 LEFT JOIN [Sayfa2$] as s2 ON s1.[Malzeme No1]=s2.[Malzeme No2]"
    rs.Open sorgu, con, 1, 1
    Sayfa3.Range("A2").End(3)(2, 1).CopyFromRecordset rs
    rs.Close
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlandı.", vbInformation, "Www.ExcelTurkey.Com"
    Set con = Nothing: Set rs = Nothing: sorgu = vbNullString
End Sub