Validation Drop-List crashes with more than 21 values

This is my first question. I'm trying to make a very simple macro on VBA for Excel.

I want the code to open a database in Access, read the Table Names from the database, save them in a dynamic string, and then use that value to create a drop-list on a specific cell on the sheet.

The code is part of a group of macros, so when finishing the above, it creates a button next to the dropdown cell, and launches a message to warn the user that, after selecting the desired table, he/she should press a button to launch the next macro (which I don't report because that one works fine).

Here's the code I've been using so far:

Sub consultaAccess_v4_1()
    Dim cn As Object
    Dim datos As Object
    Dim consultaSQL As String
    Dim conexion As String
    Dim cont As Long
    Dim rs As ADODB.Recordset
    Dim NombresTablas() As String
    
    Sheets("Indice").Select
    Range("C10").Clear
    
    Set cn = CreateObject("ADODB.Connection")
    conexion = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=C:\Users\0205406\Desktop\Base_Datos(EN PROCESO).accdb"
        
    cn.Open conexion

    Set rs = cn.OpenSchema(adSchemaTables)
    i = 0
    a = 0
    Do While Not rs.EOF
        If rs.Fields("TABLE_NAME").Value Like "MSys*" Then
            rs.MoveNext
        ElseIf rs.Fields("TABLE_NAME").Value Like "~*" Then
            rs.MoveNext
        Else
            ReDim Preserve NombresTablas(i)
            NombresTablas(i) = rs.Fields("TABLE_NAME").Value
            rs.MoveNext
            i = i + 1
            a = a + 1
            If a = 21 Then
                Exit Do
            End If
        End If
    Loop

    With Worksheets("Indice").Range("C10").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:=Join(NombresTablas, ",")
    End With
    
    cn.Close
    Set cn = Nothing
    
    ActiveSheet.Buttons.Delete
    Dim t As Range
    Set t = ActiveSheet.Range(Cells(10, 5), Cells(10, 5))
    Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
    With btn
        .OnAction = "consultaAccess_v4_2"
        .Caption = "Continuar"
        .Name = "Continuar"
    End With
        
    Range("C10").Select
    MsgBox "Seleccione una tabla del desplegable y pulsa 'Continuar'"
End Sub

The macro works fine, and it works as I want it to work, but I have a problem: if I launch it, and close excel saving changes, when I open it again, I get the following message:

For non-Spanish speakers, the error says that there is a bug in the content of the book, and that if I trust the content, excel can try to recover as much of it as possible. After clicking on "Yes" and opening the VBA, this is what happens:

Essentially, the workbook becomes corrupted, duplicates the sheets, and deletes all the buttons you could have drawn and associated with macros on any of them.

Debugging the code, I have found the bug, but I don't quite understand its cause.

It seems that the list that is added to the dropdown is too big, and that's why excel explodes when reopening (if I don't launch the macro, everything opens smoothly). I have tried to modify the code as follows (adding a maximum of 21 values for the dropdown), and doing so I have no problem. Even so, I had understood that the maximum number of values that can be added to a dropdown is around 200 and some...

Sub consultaAccess_v4_1()
    Dim cn As Object
    Dim datos As Object
    Dim consultaSQL As String
    Dim conexion As String
    Dim cont As Long
    Dim rs As ADODB.Recordset
    Dim NombresTablas() As String
    
    Sheets("Indice").Select
    Range("C10").Clear
    
    Set cn = CreateObject("ADODB.Connection")
    conexion = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=C:\Users\0205406\Desktop\Base_Datos(EN PROCESO).accdb"
        
    cn.Open conexion

    Set rs = cn.OpenSchema(adSchemaTables)
    i = 0
    a = 0
    Do While Not rs.EOF
        If rs.Fields("TABLE_NAME").Value Like "MSys*" Then
            rs.MoveNext
        ElseIf rs.Fields("TABLE_NAME").Value Like "~*" Then
            rs.MoveNext
        Else
            ReDim Preserve NombresTablas(i)
            NombresTablas(i) = rs.Fields("TABLE_NAME").Value
            rs.MoveNext
            i = i + 1
            a = a + 1
            If a = 21 Then
                Exit Do
            End If
        End If
    Loop

    With Worksheets("Indice").Range("C10").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:=Join(NombresTablas, ",")
    End With
    
    cn.Close
    Set cn = Nothing
    
    ActiveSheet.Buttons.Delete
    Dim t As Range
    Set t = ActiveSheet.Range(Cells(10, 5), Cells(10, 5))
    Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
    With btn
        .OnAction = "consultaAccess_v4_2"
        .Caption = "Continuar"
        .Name = "Continuar"
    End With
        
    Range("C10").Select
    MsgBox "Seleccione una tabla del desplegable y pulsa 'Continuar'"
End Sub

Any idea how to fix this problem? I've been thinking about it for days and nothing.