Code in CopyingDatabase (db 1) copies all tables from source database (db 2) to destination database (db 3).

Public Sub copyAllTables(sourceDatabase As String, _
                          destinationDatabase As String)
On Error GoTo copyAllTables_err
    Dim datCopied As Date
    
    datCopied = getCopiedDate

    If datCopied = #1/1/1800# Then
        
        If doCopy(sourceDatabase, destinationDatabase) Then recordCopied CurrentUser, Date, False
    
    Else
        
        If MsgBox("All database tables were copied on " & datCopied & "." & vbNewLine & _
                  "Do you wish to overwrite the previously copied tables?", vbYesNo, "Copy Tables") = vbYes Then
            
            deleteAllTables destinationDatabase
            If doCopy(sourceDatabase, destinationDatabase) Then recordCopied CurrentUser, Date, True
        
        End If
    
    End If
    
copyAllTables_exit:
    Exit Sub
    
copyAllTables_err:
    errorMessage "copyAllTables", "modCopyTables"
    Resume copyAllTables_exit
    
End Sub

Private Function doCopy(sourceDatabase As String, _
                        destinationDatabase As String) As Boolean

On Error GoTo doCopy_err
    Dim cnSource As New ADODB.Connection, cnDestination As New ADODB.Connection
    Dim catSource As New ADOX.Catalog, catDestination As New ADOX.Catalog
    Dim tblSource As New ADOX.Table, tblDestination As New ADOX.Table
    Dim inxSource As New ADOX.Index, inxDestination As New ADOX.Index
    Dim cmDestination As New ADODB.Command, rsSource As New ADODB.Recordset
    Dim i As Integer, strDestinationFields As String
    Dim fieldName As String, fieldType As Integer, fieldSize As Integer
    Dim vntSQL As Variant, vntSourceFields As Variant
    
    
    cnSource.connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                "Data Source=" & sourceDatabase & ";"

    cnDestination.connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                     "Data Source=" & destinationDatabase & ";"

    
    cnSource.Open
    catSource.ActiveConnection = cnSource
    
    cnDestination.Open
    catDestination.ActiveConnection = cnDestination
    
    cmDestination.ActiveConnection = cnDestination
    
    For Each tblSource In catSource.Tables
        
        If Left(tblSource.Name, 4) <> "MSYS" Then
            
            With tblDestination
                
                .Name = tblSource.Name
                
                Set .ParentCatalog = catDestination
                
                ' Create fields and append them to the
                For i = 0 To tblSource.Columns.Count - 1
                    
                    fieldName = tblSource.Columns(i).Name
                    fieldType = tblSource.Columns(i).Type
                    fieldSize = tblSource.Columns(i).DefinedSize
                    
                    With .Columns
                        
                        .Append fieldName, fieldType, fieldSize
                    
                    End With
                Next
                    
                ' add indexes to table
                For Each inxSource In tblSource.Indexes
                    
                    With inxDestination
                       .Name = inxSource.Name
                       .IndexNulls = inxSource.IndexNulls
                       
                        For i = 0 To inxSource.Columns.Count - 1
                            
                            fieldName = inxSource.Columns(i).Name
                            
                            .Columns.Append fieldName
                            .Columns(fieldName).SortOrder = inxSource.Columns(i).SortOrder
                        Next
                        
                    End With
                    
                    tblDestination.Indexes.Append inxDestination
                    
                    Set inxDestination = Nothing
                Next
            
            End With
            
            ' add table to destination database
            catDestination.Tables.Append tblDestination
            catDestination.Tables.Refresh
            
            
            ' add data to destination table
            rsSource.Open "Select * from [" & tblSource.Name & "];", cnSource, adOpenStatic, adLockOptimistic
            
            If rsSource.BOF And rsSource.EOF Then GoTo nextTable
            
            rsSource.MoveFirst
            
            Do Until rsSource.EOF
                
                For i = 0 To rsSource.Fields.Count - 1
                    'Debug.Print rsSource.Fields(i).Name & ": " & rsSource.Fields(i).Type & " - " & rsSource.Fields(i).Value
                    strDestinationFields = strDestinationFields & rsSource.Fields(i).Name & ", "
                    
                    If IsNumeric(rsSource.Fields(i).Value) Or _
                       rsSource.Fields(i).Type = 3 Then
                        vntSourceFields = vntSourceFields & _
                                          Nz(rsSource.Fields(i).Value, 0) & ", "
                                          
                    ElseIf IsDate(rsSource.Fields(i).Value) Then
                        vntSourceFields = vntSourceFields & "#" & rsSource.Fields(i).Value & "#, "
                    
                    Else
                        If IsNull(rsSource.Fields(i).Value) Then
                            If rsSource.Fields(i).Type = 202 Or 203 Then
                            
                                vntSourceFields = vntSourceFields & "', "
                        
                            Else
                                vntSourceFields = vntSourceFields & _
                                                  Null & ", "
                            End If
                        Else
                            vntSourceFields = vntSourceFields & _
                                              Chr(34) & Replace(rsSource.Fields(i).Value, Chr(34), "'") & Chr(34) & ", "
                        End If
                    End If
                Next
                                
                ' remove ending comma from field list
                strDestinationFields = Trim(Left(strDestinationFields, Len(strDestinationFields) - 2))
                vntSourceFields = Trim(vntSourceFields)
                vntSourceFields = Left(vntSourceFields, Len(vntSourceFields) - 1)

                vntSQL = "INSERT INTO [" & tblDestination.Name & "] ("
                vntSQL = vntSQL & strDestinationFields & ") VALUES ("
                vntSQL = vntSQL & vntSourceFields & ");"
                
                cmDestination.CommandText = vntSQL
                                            
                cmDestination.Execute
                
                vntSQL = ""
                vntSourceFields = ""
                strDestinationFields = ""
            
                rsSource.MoveNext
            Loop
            
nextTable:
            Set tblDestination = Nothing
        End If
        
        If rsSource.State <> adStateClosed Then rsSource.Close
        
    Next
    
    doCopy = True
    
doCopy_exit:
    If cnSource.State <> adStateClosed Then cnSource.Close
    If cnDestination.State <> adStateClosed Then cnDestination.Close
    Set cnSource = Nothing
    Set cnDestination = Nothing
    Set cmDestination = Nothing
    Set catSource = Nothing
    Set catDestination = Nothing
    Set tblSource = Nothing
    Set tblDestination = Nothing
    Exit Function
    
doCopy_err:
    If Err.Number = 3367 Then ' table already in collection
        Resume Next
    Else
        doCopy = False
        errorMessage "doCopy", "modCopyTables"
        Resume doCopy_exit
    End If
End Function

Private Sub recordCopied(userID As String, dateCopied As Date, update As Boolean)
On Error GoTo recordCopied_err
    Dim strSQL As String
    
    If update Then
        strSQL = "UPDATE tblCopied SET DateCopied = #" & dateCopied & "# " & _
                 "WHERE (((UserID)='" & userID & "'));"

    Else
        strSQL = "INSERT INTO tblCopied ( UserID, DateCopied )" & _
                 "SELECT '" & userID & "' AS [User], " & _
                 "#" & dateCopied & "# AS DateCopied;"

    End If
    
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True
    
recordCopied_exit:
    Exit Sub
    
recordCopied_err:
    errorMessage "recordCopied", "modCopyTables"
    Resume recordCopied_exit
End Sub

Private Function getCopiedDate() As Date
On Error GoTo getCopiedDate_err
    Dim strCurrentUser As String, strSQL As String
    
    strCurrentUser = CurrentUser()
    
    openDatabase CurrentProject.Connection
    
    strSQL = "SELECT Max(DateCopied) AS MaxOfDateCopied " & _
             "FROM tblCopied " & _
             "GROUP BY UserID " & _
             "HAVING (((UserID)='" & strCurrentUser & "'));"
             
    rsADO.Open strSQL, cnADO, adOpenStatic, adLockReadOnly
    
    If rsADO.BOF And rsADO.EOF Then
        getCopiedDate = #1/1/1800#
    Else
        getCopiedDate = rsADO!maxofdatecopied
    End If
    
getCopiedDate_exit:
    rsADO.Close
    closeDatabase
    killAdodbVariables
    Exit Function
    
getCopiedDate_err:
    getCopiedDate = #1/1/1800#
    errorMessage "getCopiedDate", "modCopyTables"
    Resume getCopiedDate_exit
End Function

Private Sub deleteAllTables(databaseToDelete As String)
On Error GoTo deleteAllTables_err

    Dim oCatalog As New ADOX.Catalog
    Dim i As Integer, j As Integer, strTableNames() As String
    
    openDatabase "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                 "Data Source=" & databaseToDelete & ";"

    oCatalog.ActiveConnection = cnADO
    cmADO.ActiveConnection = cnADO
    
    ReDim strTableNames(oCatalog.Tables.Count - 1)
    j = 0
    
    For i = 0 To oCatalog.Tables.Count - 1
        If Left(oCatalog.Tables.Item(i).Name, 4) <> "msys" And Left(oCatalog.Tables.Item(i).Name, 1) <> "~" Then
            strTableNames(j) = oCatalog.Tables.Item(i).Name
            j = j + 1
        End If
    Next
    
    ReDim Preserve strTableNames(j)
    
    For i = 0 To UBound(strTableNames) - 1
        cmADO.CommandText = "DROP TABLE [" & strTableNames(i) & "]"
        cmADO.Execute
    Next
    
deleteAllTables_exit:
    closeDatabase
    killAdodbVariables
    Set oCatalog = Nothing
    Exit Sub
    
deleteAllTables_err:
    errorMessage "deleteAllTables", "modCopyTables"
    Resume deleteAllTables_exit
End Sub

Public cnADO As New ADODB.Connection
Public cmADO As New ADODB.Command
Public rsADO As New ADODB.Recordset

Public Sub openDatabase(connectionString As String)
On Error GoTo openDatabase_err

    If cnADO.State <> adStateOpen Then
        cnADO.Open connectionString
    End If
    Exit Sub
    
openDatabase_err:
    errorMessage "Open Database", "modADODB"
    Exit Sub
End Sub

Public Sub closeDatabase()
On Error GoTo closeDatabase_err

    If cnADO.State <> adstateclose Then
        cnADO.Close
    End If
    Exit Sub
    
closeDatabase_err:
    errorMessage "Close Database", "modADODB"
    Exit Sub
End Sub

Public Sub activateCommand()
On Error GoTo activateCommand_err

    cmADO.ActiveConnection = cmADO
    Exit Sub
    
activateCommand_err:
    errorMessage "Activate Command", "modADODB"
    Exit Sub
End Sub

Public Sub killAdodbVariables()
On Error GoTo killAdodbVariables_err

    Set cnADO = Nothing
    Set cmADO = Nothing
    Set rsADO = Nothing
    Exit Sub
    
killAdodbVariables_err:
    errorMessage "Kill ADODB Variables", "modADODB"
    Exit Sub
End Sub

Public Sub errorMessage(procedureName As String, moduleName As String)
    If Err.Number <> 0 Then
        MsgBox "The following error occurred in " & _
               procedureName & " in module " & moduleName & ":" & vbNewLine & _
               "Error Number: " & Err.Number & vbNewLine & _
               "Description: " & Err.Description & vbNewLine & vbNewLine & _
               "Should this error continue, please contact the database administrator.", _
               vbCritical, "ERROR MESSAGE"
        Exit Sub
    End If
    Exit Sub
End Sub