Sub Insert2Access()
    Dim CON As Object: Set CON = CreateObject("ADODB.Connection")
    Dim iRow&, iCol&, LastRow&, LastCol&
    Dim sFields$, sValues$, sSQL$
    Dim ErrHandler As Label

On Error Resume Next  ' если в макросе произойдет ошибка, то макрос не остановится и пойдет дальше. _
      Не самое лучшее решение но позволит дойти до проверки If Err.Number <> 0 Then
    
    CON.Open IIf(Val(Application.Version) < 12, "Provider='Microsoft.Jet.OLEDB.4.0'", "Provider='Microsoft.ACE.OLEDB.12.0'") & _
            "; Data Source=" & ThisWorkbook.Path & "\Data.accdb" & ";Mode=Share Deny None; Jet OLEDB:Database;"
    With Worksheets("Base")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        
        For iCol = 1 To LastCol ' создаем строку с названиями полей
            sFields = IIf(iCol > 1, sFields & ", ", "") & "[" & .Cells(1, iCol).Value & "]"
        Next iCol
        
        For iRow = LastRow To LastRow ' создаем строку значений
            For iCol = 1 To LastCol
                sValues = IIf(iCol > 1, sValues & ", ", "") & _
                        IIf(iCol > 22, "", "'") & _
                        IIf(.Cells(iRow, iCol).Value = 0, "Null", Replace(CStr(.Cells(iRow, iCol).Value), ",", ".")) & _
                        IIf(iCol > 22, "", "'")
            Next iCol
            sSQL = "INSERT INTO [" & "table" & "] (" & sFields & ") VALUES (" & sValues & ");"
'Debug.Print sSQL
            'Заполняем таблицу данными
            CON.Execute sSQL
        Next iRow
    End With
    CON.Close
    If Err.Number <> 0 Then
      If vbYes = MsgBox("Данные не перенесено. Попробовать еще раз?", vbYesNo, "111") Then Insert2Access
    End If
    
End Sub