Hello, I have been working on this project. I have 2000 tables in my access database and want to append all of them to one table. Please HELP!!

Private Sub Append()

Dim db As Database
Dim str As String
Dim newr As Recordset
Dim oldr As Recordset

Set db = currentdatabase
Set newr = db.OpenRecordset("Main")

For Each TableDef In db.TableDefs

str = TableDef.Name

If str <> "Main" Then
Set oldr = db.OpenRecordset(str)
Dim strSQL As String
strSQL = "INSERT INTO " & newr & " SELECT * FROM " & oldr & ""
db.Execute strSQL

newr.Update

oldr.Close

End If

Next TableDef

Set oldr = Nothing
Set newr = Nothing

End Sub

Thanks,