Yardım ADO SQL ile diğer sayfadaki verilerle işlem

Sub sql()
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 8.0;hdr=no"""
sorgu = "Select f1,f2,sum(f3) from tablo1 group By f1,F2 order by f1 asc"
rs.Open sorgu, con
Sayfa1.Range("B1").CopyFromRecordset rs
End Sub

Sub TEST()
Sayfa1.Range("M1:O65536").ClearContents
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 8.0;hdr=no"""
sorgu = sorgu & "SELECT DISTINCT f1 FROM tablo1 "
rs.Open sorgu, con, 1, 1

Do While Not rs.EOF
Range("M1") = "Kod"
Range("n1") = "Adı"
Range("o1") = "Tutar"
vedat = Cells(Rows.Count, 13).End(3).Row + 1
Range("M" & vedat) = rs("F1").Value
Range("M" & vedat + 1) = rs("F1").Value
Range("M" & vedat + 2) = rs("F1").Value
Range("N" & vedat) = "gec"
Range("N" & vedat + 1) = "idari"
Range("N" & vedat + 2) = "sağlık"
rs.movenext
Loop
rs.Close
con.Close

ff = Cells(Rows.Count, 13).End(3).Row

With Range("O2:O" & ff)
.Formula = "=SUMPRODUCT((Tablo1!R1C1:R65536C1=Sayfa1!RC[-2])*(Tablo1!R1C2:R65536C2=Sayfa1!RC[-1])*(Tablo1!R1C3:R65536C3))"
.Value = .Value
End With

With Range("m2:O" & ff)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=$O2=0"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(.FormatConditions.Count).Interior.Color = -16777024
.FormatConditions(.FormatConditions.Count).StopIfTrue = True
End With

MsgBox "İşlem Tamam", vbInformation, "Excel Turkey"
End Sub

Sub TEST()
With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
     .EnableEvents = False
End With

Sayfa1.Range("M1:O65536").ClearContents
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 8.0;hdr=YES"""
sorgu = sorgu & "SELECT DISTINCT KOD FROM [Tablo1$] ORDER BY  KOD "
rs.Open sorgu, con, 1, 1
Do While Not rs.EOF
Range("M1") = "Kod"
Range("n1") = "Adı"
Range("o1") = "Tutar"
vedat = Cells(Rows.Count, 13).End(3).Row + 1
Range("M" & vedat) = rs("KOD").Value
Range("M" & vedat + 1) = rs("KOD").Value
Range("M" & vedat + 2) = rs("KOD").Value
Range("N" & vedat) = "gec"
Range("N" & vedat + 1) = "idari"
Range("N" & vedat + 2) = "sağlık"
rs.movenext
Loop
rs.Close

Set rs1 = CreateObject("adodb.recordset")
T = T & "SELECT  IIF(ISNULL(TUTAR),0,TUTAR) AS TUTAR FROM (SELECT sayfa1.KOD,sayfa1.[Adı],SUM(sayfa2.[TUTAR]) AS TUTAR from [sayfa1$] sayfa1 left join [Tablo1$] sayfa2 on sayfa1.[KOD]=sayfa2.[KOD] AND sayfa1.[Adı]=sayfa2.[AD] "
T = T & "GROUP BY sayfa1.KOD,sayfa1.Adı) AS TM ORDER BY KOD "
rs1.Open T, con, 1, 1
Sayfa1.Range("O1").CopyFromRecordset rs1
Range("o1") = "Tutar"
con.Close

  With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
      .EnableEvents = True
  End With
 
MsgBox "İşlem Tamam", vbInformation, "Excel Turkey"
End Sub