Esta rutina sirve para copiar todas las tablas de una base de datos origen en una destino. Si las tablas ya existían en la base de datos de destino se eliminan y se vuelven a crear con la misma estructura que tuvieran en origen.
Las tablas de la base destino que no se encuentren en origen no se modifican.
Si el parámetro boCopiarDatos es true (valor por defecto) además de la estructura se copian los datos de las tablas.


Sub CopiaTablas(strOrigen As String, strDestino As String, Optional boCopiarDatos As Boolean = True)
Dim dbOrigen As Database, dbDestino As Database
Dim tdOrigen As TableDef, tdDestino As TableDef
Dim fdOrigen As Field, fdDestino As Field
Dim idOrigen As Index, idDestino As Index
Dim prOrigen As Property, prDestino As Properties
Dim i As Long

Screen.MousePointer = vbHourglass
'abrir origen y destino
Set dbOrigen = OpenDatabase(strOrigen, False)
Set dbDestino = OpenDatabase(strDestino, True)
'hay propiedades que no se pueden copiar como el value de los campos, etc
On Error Resume Next
'para cada tabla de origen
For Each tdOrigen In dbOrigen.TableDefs
    If (tdOrigen.Attributes And (dbSystemObject Or dbHiddenObject)) = 0 Then
        'si la tabla no es del sistema
        'mirar si existe la tabla en destino
        For Each tdDestino In dbDestino.TableDefs
            If tdDestino.Name = tdOrigen.Name Then
                'si existe la borro
                dbDestino.TableDefs.Delete tdDestino.Name
                Exit For
            End If
        Next
        'creo la tabla en el destino
        Set tdDestino = dbDestino.CreateTableDef(tdOrigen.Name, tdOrigen.Attributes, tdOrigen.SourceTableName, tdOrigen.Connect)
        'le añado los campos
        For Each fdOrigen In tdOrigen.Fields
            Set fdDestino = tdDestino.CreateField(fdOrigen.Name, fdOrigen.Type, fdOrigen.Size)
            'copio las propiedades del campo
            For Each prOrigen In fdOrigen.Properties
                fdDestino.Properties(prOrigen.Name) = fdOrigen.Properties(prOrigen.Name)
            Next
            tdDestino.Fields.Append fdDestino
        Next
        'le añado los indices
        For Each idOrigen In tdOrigen.Indexes
            Set idDestino = tdDestino.CreateIndex(idOrigen.Name)
            'añado los campos al índice
            For Each fdOrigen In idOrigen.Fields
                Set fdDestino = idDestino.CreateField(fdOrigen.Name)
                idDestino.Fields.Append fdDestino
            Next
            'copio las propiedades del índice
            For Each prOrigen In idDestino.Properties
                idDestino.Properties(prOrigen.Name) = idOrigen.Properties(prOrigen.Name)
            Next
            tdDestino.Indexes.Append idDestino
        Next
        dbDestino.TableDefs.Append tdDestino
        'copio los datos de la tabla, si se solicitó
        If boCopiarDatos Then dbOrigen.Execute ("INSERT INTO " + tdDestino.Name + " IN '" + strDestino + "' SELECT * FROM " + tdDestino.Name)
    End If
Next
'cerrar origen y destino
dbOrigen.Close
dbDestino.Close
Set dbOrigen = Nothing: Set dbDestino = Nothing
Set tdOrigen = Nothing: Set tdDestino = Nothing
Set fdOrigen = Nothing: Set fdDestino = Nothing
Set idOrigen = Nothing: Set idDestino = Nothing
Set prOrigen = Nothing: Set prDestino = Nothing
Screen.MousePointer = vbDefault
End Sub