Sayın berduş hocam öncelikle saygılarımı sunar iyi çalışmalar dilerim. Yardımlarınızla yukarıdaki konuyu çözüme kavuşturduk. Kod aşağıdaki gibi. Ek olarak exccele aktarım yaparken excceldeki eski verileri nasıl sileriz. Yani sorgu sunucu boşsa excelleki eski kayıtlarıda silsin.Nasıl bir ekleme yapabiliriz.  Saygılarımla iyi çalışmalar.

Private Sub Komut10_Click() 'POZİTİF
Dim TabloAdi As String
Dim XlAd As String
Dim SyfAd As String


TabloAdi = "Srg_covit_EXCELL_POZATİF"
XlAd = CurrentProject.Path & "\Şablon.xlsx"
SyfAd = "POZİTİF" '& "$"

'hy Excele sayfasına verileri biçimli aktarma_____________________________
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim StrAna As String

Set dbs = CurrentDb
StrAna = "SELECT [t_tcno],[AdıSoyadı],[t_mudrlük],[t_gorevyeri],[Yaşı],[t_ilce],[t_hastaneadi],[t_telefon] FROM Srg_covit_EXCELL_POZATİF" 'ya alanların ismi tek tek yazılacak yada _
                                                            sadece gerekli alanların olduğu bir sorgu oluşturup oradan select * diyeceksiniz
Set rsSQL = dbs.OpenRecordset(StrAna, dbOpenSnapshot)


If rsSQL.RecordCount > 0 Then
rsSQL.MoveLast
rsSQL.MoveFirst
Else
Exit Sub
End If
'hy Exceli aç
   
    Dim XlAc As Excel.Application
    Dim XlKtp As Excel.Workbook
    Dim XlSyf As Excel.Worksheet
    Dim xRng As Excel.Range
    Dim SonStr As Long

    Set XlAc = CreateObject("Excel.Application")
    Set XlKtp = XlAc.Workbooks.Open(XlAd)
    Set XlSyf = XlKtp.Worksheets(SyfAd)
    XlAc.Visible = False
    SonStr = XlSyf.Cells(XlSyf.Rows.Count, 2).End(xlUp).row + 1 'XlAc.UsedRange.Rows(XlAc.UsedRange.Rows.Count).row
    Debug.Print SonStr
   
  XlSyf.Range("B2:Z" & SonStr).ClearContents
    XlSyf.Range("B2").CopyFromRecordset rsSQL
rsSQL.Close
Set rsSQL = Nothing

'XlSyf.Range("A1").CurrentRegion.Select
Set xRng = XlAc.Selection
With xRng
'    .Columns.AutoFit
'    .Borders.LineStyle = xlContinuous
    .BorderAround LineStyle:=xlContinuous ', Weight:=xlThick
End With
''          İsterseniz aşağıdaki satırı da aktifleştrebilirsiniz
XlKtp.Save
XlAc.Quit

    Set XlAc = Nothing
    Set XlKtp = Nothing
    Set XlSyf = Nothing
'''Set xRng = Nothing