öncelikle referanslardan Microsoft ActiveX data objects xx library eklenmeli
sonra yeni bir modül eklenip modüle aşağıdaki fonksiyon tanımlanmalı

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 '& " order by [F1];"



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

excele alma butonunun kodu da aşağıdaki gibi olmalı

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

For Each Name In SyfAdiDz

    Debug.Print Name

Next



AccessAl SyfAdiDz()

    MsgBox "aktarım tamam"

---

henüz accesse aktarma kısmındaki boş kayıtları silme kodu eklenmemiştir
o nedenle tabloda boş kayıtlar olabilir