Hi All,
Trying to set up a Common Database which will update all users'
"Personal.xls" file so that Templates can be updated from this common
database and common Range Names can be applied to multiple Templates. The
code is in the Workbook_Open of Personal.xls and will automatically update
Range Names and Database.

Through the help from Ron de Bruin (thank you !!) site and from MS KB I have
managed to get what I want except the refreshing of the Range names. The code
stops while looping through the Defined Names and gives me a Run-Time error
1004 - Applicaton-Defined or object defined error. I have copied the listing
below. Can someone please help as going spare trying to find the error.

Private Sub Workbook_Open()

Dim Basebook As Workbook
Dim Mybook As Workbook
Dim MyFiles() As String
Dim SourceRange As Range
Dim DestRange As Range
Dim RNum As Long
Dim Fnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim FilesInPath As String
Dim SaveDriveDir As String
Dim ShtName As Variant
Dim N As Integer
Dim Str As String
Dim x
Dim Sht As Worksheet

'
--------------------------------------------------------------------------------
' Save current directory drive
SaveDriveDir = CurDir

'
--------------------------------------------------------------------------------
' Fill in the Path\Folder where the files are
MyPath = "\\Nt_Gulf\d\AlphaDB"

' Add a slash at the end if the user forgot it
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

'
--------------------------------------------------------------------------------
' If there is no Excel file in the folder exit sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'
--------------------------------------------------------------------------------
' On Error GoTo CleanUp
Application.ScreenUpdating = False
Set Basebook = ThisWorkbook

' Clear all cells in the first sheet
Basebook.Worksheets(1).Cells.Clear

RNum = 1
' -------------------------------------------------------------------------
' Fill the array (MyFiles) with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
' -------------------------------------------------------------------------

Set Mybook = Workbooks.Open(MyPath & MyFiles(Fnum))

' -------------------------------------------------------------------------
' You want to copy the range from all sheets in this Array
ShtName = Array("Transactions", "Signatories", "Crew", "Banks", _
"Banks", "Departments", "BankManagementAccts", "AccountsDB", _
"Suppliers", "CurrencyAbrv", "VslsAndCompanies")

' -------------------------------------------------------------------------
' Loop through all files in the array (myFiles) and create the
Personal.xls workbook sheets contents

If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set Mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
For N = LBound(ShtName) To UBound(ShtName)
Str = ShtName(N)

'If the sheet does not exist in the workbook it will be created
in the basebook
'You can delete this line if you are sure all sheets exist in
the basebook
If Not SheetExists(Str, Basebook) Then
Basebook.Worksheets.Add.Name = Str

'Copy the range from the sheet in mybook into the sheet basebook
If SheetExists(Str, Mybook) Then

Set SourceRange = Mybook.Worksheets(ShtName(N)).UsedRange
Set DestRange = Basebook.Worksheets(ShtName(N)).UsedRange

DestRange.Cells.Clear

SourceRange.Copy DestRange

End If
Next N
Next Fnum
End If

' -------------------------------------------------------------------------
' Populate the array with all Workbook Names from AlphaDB and to be copied
' Personal.xls workbook

Mybook.Activate

' Loop through all of the defined names in the active
' workbook.
For Each x In Mybook.Names
' Add each defined name from the active workbook to
' the target workbook ("Book2.xls").
' "x.value" refers to the cell references the
' defined name points to.
Workbooks("Personal.xls").Names.Add Name:=x.Name, _
RefersTo:=x.Value
Next x

' -------------------------------------------------------------------------
' Windows("PERSONAL.XLS").Visible = True
Mybook.Activate
Debug.Print ActiveWorkbook.Name

Windows("PERSONAL.XLS").Visible = False

Mybook.Close False

CleanUp:

Application.ScreenUpdating = True

End Sub