[gaz_manos]

Αρχική Δημοσίευση από Tasos

Καλησπέρα!
Μάνο, έστω ότι ο πίνακας ονομάζεται "BigTable" και το πεδίο ομαδοποίησης "OMADA"

Ο παρακάτω κώδικας νομίζω ότι θα σε εξυπηρετήσει:

Option Compare Database
Option Explicit

Sub Test()
'MainTableName = "το όνομα του πίνακα"
'GroupFieldName = "το όνομα του πεδίου ομαδοποίησης"
'OverWriteTables: True για αντικατάσταση πινάκων με το ίδιο όνομα.
    SplitTable MainTableName:="BigTable", GroupFieldName:="OMADA", OverWriteTables:=True
End Sub

Function SplitTable(MainTableName As String, _
                    GroupFieldName As String, _
                    OverWriteTables As Boolean)
    Dim dbs As DAO.Database
    Dim rsTeams As DAO.Recordset
    Dim strSQL As String
    Dim AllTables As DAO.TableDefs
    Dim GroupField As DAO.Field
    Dim NewTableName As String

    MainTableName = "[" & MainTableName & "]"
    GroupFieldName = "[" & GroupFieldName & "]"

    Set dbs = CurrentDb
    Set AllTables = dbs.TableDefs
    Set rsTeams = dbs.OpenRecordset( _
                  "SELECT DISTINCT " & MainTableName & "." & GroupFieldName & _
                  " FROM " & MainTableName & " WHERE nz(" & GroupFieldName & ","""")<>""""", dbOpenSnapshot)

    If rsTeams.RecordCount Then
        Set GroupField = rsTeams.Fields(GroupFieldName)
        rsTeams.MoveFirst
        While Not rsTeams.EOF

            NewTableName = Replace(GroupField.Value, " ", "_")
            strSQL = "SELECT " & MainTableName & ".* INTO " & NewTableName
            strSQL = strSQL & " FROM " & MainTableName & " WHERE " _
                     & MainTableName & "." & GroupFieldName & " ='" & GroupField.Value & "'"

            If TableExists(AllTables, GroupField.Value) Then
                If OverWriteTables Then
                    AllTables.Delete GroupField.Value
                    AllTables.Refresh
                Else
                    GoTo NextRec
                End If
            End If

            dbs.Execute strSQL
            AllTables.Refresh
NextRec:
            rsTeams.MoveNext

        Wend

        Application.RefreshDatabaseWindow

    End If
    rsTeams.Close
    Set rsTeams = Nothing

End Function

Function TableExists(AllTables As TableDefs, TableName As String)
    Dim tdf As DAO.TableDef
    For Each tdf In AllTables
        If tdf.Name = TableName Then
            TableExists = True
            Exit For
        End If
    Next
End Function

Καλή συνέχεια!

Τάσος

Τάσο κατ' αρχήν σε ευχαριστώ πολύ για την απάντηση σου.
Για να είμαι ειλικρινής δεν το έχω δοκιμάσει ακομά γιατί δεν ξέρω που να βάλω τον παραπάνω κώδικα που μου έστειλες.
Και πάλι ευχαριστώ.