Public Sub CreateCopyTable(strTabname As String, strNewTabName As String)
'*******************************************
'Name:      CreateCopyTable (Sub)
'Purpose:   erstellt eine leere 1:1 Kopie einer Tabelle 
'Author:    Thomas Keßler
'Date:      Mai 26, 2003, 07:08:57
'Inputs:    strTabName=alter Tabellenname,strNewTabName=neuer Tabellenname
'Output:
'*******************************************
 
On Error Resume Next
 
    Dim dbs As DAO.Database
    Dim tdfq As DAO.TableDef, tdfz As DAO.TableDef
    Dim fldq As DAO.Field, fldz As DAO.Field
    Dim idxq As DAO.Index, idxz As DAO.Index, fldIndexq As DAO.Field, fldIndexz _
      As DAO.Field
    Dim prpq As DAO.Property, prpz As DAO.Property
 
    Set dbs = CurrentDb
    Set tdfq = dbs.TableDefs(strTabname)
    Set tdfz = dbs.CreateTableDef(strNewTabName)
 
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
'Codeteil zum hinzufügen der Felder in der neuen 
'Tabelle und zuweisen der DAO-Eigenschaften 
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
        For Each fldq In tdfq.Fields
            Set fldz = tdfz.CreateField(fldq.Name, fldq.Type, fldq.Size)
            fldz.Attributes = fldq.Attributes
                If fldq.Required Then fldz.Required = True
                If fldq.AllowZeroLength Then fldz.AllowZeroLength = True
            fldz.DefaultValue = fldq.DefaultValue
            fldz.ValidationRule = fldq.ValidationRule
            fldz.ValidationText = fldq.ValidationText
            tdfz.Fields.Append fldz
            tdfz.Fields.Refresh
            'On Error Resume Next
        Next fldq
 
    dbs.TableDefs.Append tdfz
    dbs.TableDefs.Refresh
 
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
'Codeteil zum hinzufügen der Indexes und 
'der Indexfelder und Index-Eigenschaften 
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
 
        For Each idxq In tdfq.Indexes
            Set idxz = tdfz.CreateIndex(idxq.Name)
                For Each fldIndexq In idxq.Fields
                    Set fldIndexz = idxz.CreateField(fldIndexq.Name)
                    fldIndexz.Attributes = fldIndexq.Attributes
                        If idxq.Primary Then idxz.Primary = True
                        If idxq.Unique Then idxz.Unique = True
                        If idxq.Required Then idxz.Required = True
                        If idxq.IgnoreNulls Then idxz.IgnoreNulls = True
                Next fldIndexq
            idxz.Fields.Append fldIndexz
            tdfz.Indexes.Append idxz
            tdfz.Indexes.Refresh
        Next idxq
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
 
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
'Codeteil zum hinzufügen der Properties der Felder 
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
        For Each fldq In tdfq.Fields
            For Each fldz In tdfz.Fields
                For Each prpq In fldq.Properties
                    If fldq.Name = fldz.Name Then
                        Set prpq = fldq.Properties(prpq.Name)
                        Set prpz = fldz.CreateProperty(prpq.Name, prpq.Type, _
                          prpq.Value)
                        fldz.Properties.Append prpz
                        fldz.Properties.Refresh
                    End If
                Next prpq
            Next fldz
        Next fldq
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
    Set dbs = Nothing
 
End Sub

CreateCopyTable "NameOrginalTable", "NameCopyTable"

Gru? TommyK