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]