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"