Berduş Hocam eliniz dert görmesin
Zafer Hocam sizin de eliniz dert görmesin
Kodu yarın ofiste deneyip sonuç hakkında size biligi vereyim.
Kandiliniz mübarek olsun. Rabbim de sizi ikinizi de Hocalarim hiç darda bırakmasın inşallah

hala bazı ufak tefek sorunlar var mesela Excel sayfasındaki silinmiş boş satırları bile alabiliyor
tablo kayıtlar eklendikten sonra boş satırları silme kodunu henüz ayarlayamadım
sayfaları accesse aktarmada yeni bir yöntem denedim dilerim işinize yarar
tabloları excele Aktarma kodu

Sub AccessAl(SyfAdiDz() As Variant)

    Dim AdoCon As ADODB.Connection

    Dim AdoRs As ADODB.Recordset

    Dim AdoSql As String

    VtAdi = ThisWorkbook.Path & "\YILDIZ_VeriTabanı.accdb"

    Set AdoCon = New ADODB.Connection

    AdoConString = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & VtAdi

    AdoCon.Open AdoConString



Dim Sht As Worksheet

Dim SonStn As Long

Dim SyfAdi As Variant

For Each SyfAdi In SyfAdiDz

    Set AdoRs = New ADODB.Recordset

    AdoSql = "Select * from " & SyfAdi



Set Sht = ThisWorkbook.Worksheets(SyfAdi)

    SonStn = Sht.Cells(1, Sht.Columns.Count).End(xlToLeft).Column

    SonStr = Sht.Cells(Sht.Rows.Count, 1).End(3).Column

xhrf = Split(Cells(1, SonStn).Address, "$")(1)

    Sht.Range("A2:" & xhrf & Sht.Rows.Count).Clear    ' .Cells(2, SonStn).Clear

    Set AdoRs = AdoCon.Execute(AdoSql)

    Sht.Range("A2").CopyFromRecordset AdoRs

    

    AdoRs.Close

Next



    AdoCon.Close

    Set AdoRs = Nothing

    Set AdoCon = Nothing

End Sub

accessten alınacak tabloların adını listeden alma kodu

Dim SyfAdiDz() As Variant

    SyfAdi = 0

    For i = 0 To ListBox1.ListCount - 1

        If ListBox1.Selected(i) Then

            ReDim Preserve SyfAdiDz(SyfAdi)

            SyfAdiDz(SyfAdi) = ListBox1.List(i)

            SyfAdi = SyfAdi + 1

        End If

    Next i

Dim Name As Variant



AccessAl SyfAdiDz()

    MsgBox "aktarım tamam"

accesste var olan tabloları silme kodu

Function TabloSil(SilRs As Recordset, AccessConS As ADODB.Connection, ByVal SyfAdi As String)

            On Error Resume Next

            AccessSql = "DROP TABLE  " & SyfAdi

            Set SilRs = AccessConS.Execute(AccessSql)

End Function

sayfaları accesse aktarma kodu

    Dim AccessCon As ADODB.Connection

    Dim AccessRs As ADODB.Recordset

    Dim AccessSql As String

    VtAdi = ThisWorkbook.Path & "\YILDIZ_VeriTabanı.accdb"

    Set AccessCon = New ADODB.Connection

    AccessConString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & VtAdi

    AccessCon.Open AccessConString



'_________________________________________________

            Dim cn As ADODB.Connection

            Set cn = New ADODB.Connection

            VtAdi = ThisWorkbook.Path & "\YILDIZ_VeriTabanı.accdb"

            cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0"

'_________________________________________________________

    Set AccessRs = New ADODB.Recordset

    

    For i = 0 To ListBox1.ListCount - 1

        If ListBox1.Selected(i) Then

            SyfAdi = ListBox1.List(i)

            TabloSil AccessRs, AccessCon, SyfAdi

            cn.Execute "SELECT * INTO [" & SyfAdi & "] IN '" & VtAdi & "' FROM [" & SyfAdi & "$];"



        End If

    Next i

            cn.Close

            Set cn = Nothing

            MsgBox "aktarım tamam"

son hali aşağıdadır boş kayıtları almaması için kriter ekledim
yalnız 2 yerde sorun çıktı
1 - hala bazı sütun başlıklarında "." Nokta var; aktarmada sorun çıkarmasa da dikkatli olun
2 - hatırlatma sayfanız sorunlu sütun başlıkları arasında tarih alanı var o sütunları sildim dikkatli olun
dilerim işinize yarar
Not: veritabanınız eklenip/silinen her tablo/kayıttan sonra şişer henüz sıkıştır/onar kodunu ekleyemediğimden şimdilik sizin accessi açıp sıkıştır/onar yapmanz uygun olur
Kriter ekleme kodu

Function BosKytOlcut(Syf As Worksheet) As String

Dim Hcr As Range, AlanAdi As Range

Dim SonStnHrf As String

    SonStnHrf = Syf.UsedRange.Address

    Set AlanAdi = Syf.Range("A1:" & Split(SonStnHrf, "$")(3) & "1")

    For Each Hcr In AlanAdi.Cells

        If Len(Hcr.Value & "") > 0 Then BosKytOlcut = BosKytOlcut & " & [" & Hcr.Value & "]"

    Next Hcr

End Function

accesse aktarma kodunda yapılan değişiklikler

            Set Syf = Worksheets(SyfAdi) 

            Krtr = BosKytOlcut(Syf)

            Krtr = " where len(" & "'' " & Krtr & ")>0"

            Krtr = Replace(Krtr, ".", "#")

            cn.Execute "SELECT * INTO [" & SyfAdi & "] IN '" & VtAdi & "' FROM [" & SyfAdi & "$]" & Krtr & ";"  '[" & SyfAdi & "$A1:AL20]

Hocam accessten Excel e aktar derken
Function TabloSil(SilRs As Recordset, AccessConS As ADODB.Connection, ByVal SyfAdi As String)
Kısmında

Excelden accesse aktar derken
Dim AccessCon As ADODB.Connection

Kısımlarını göstererk hata veriyor

---

Referansı da ekledim ama sizin dosyada çalışan kofu kendi dosyama alırken hata veriyor
Hatta şöyle yaptım.
Userformu direkt sizden aldım
Modülü tamamen kopyalayıp yapıştırdım. Yine olmadı

Referanslarınızda DAO ile ilgili bir referans var mı?
Varsa DAOlu referansı devre dışı bırakıp oyle dener misiniz

Gönderdiğim dosya sizde çalışıyor mu?
Eğer çalışıyorsa dosyanizdaki sayfaları gönderdiğim dosyaya ekleyip orada dener misiniz.
Bu arada ofis sürümünüz ne?