Public Sub RenameAllTables(strToFind As String, strToReplace)

Dim dbs As Database
Dim tdf As TableDef

Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
   Dim tdfNewName As String

   tdfNewName = Replace(tdf.Name, strToFind, strToReplace)

   If tdfNewName <> tdf.Name Then
       DoCmd.Rename tdfNewName, acTable, tdf.Name
   End If

Next

End Sub