Transfer named cell values between workbooks

[meiklg1]

Hi,

I have been using Ken Puls's BCMerge code to successfully transfer information between Excel and Word and figured that it would be easy enough to alter the code to transfer information between workbooks by looping through all named cells in a workbook and transferring them to identical named cells in another workbook. So far all my attempts have failed. Does anybody have an idea of where I've gone wrong? My altered code is below. The VBE shows it failing at the error handler but I think the problem has something to do with the objects as it loops through the names in the sheet.

 
Private Sub CommandButton7_Click()
'Merge directory with Hazard Identification Checklist.xls
Dim pappExcel As Object
Dim wbExcel As Object
Dim wb As Excel.Workbook
Dim xlName As Excel.Name
Dim TodayDate As String
Dim Path As String
  Unload Me
  
  Set wb = ActiveWorkbook
  TodayDate = Format(Date, "mmmm d, yyyy")
  Path = ("M:\HEALTH & SAFETY\01.00 - LG MS Procedures\0.1 - CDMC MSP\GM Template Test\Hazard Identification Checklist.xlt")
  
  On Error GoTo ErrorHandler
'Create a new Excel Session
  Set pappExcel = CreateObject("Excel.Application")
  
  On Error GoTo ErrorHandler
'Open workbook in Excel
  Set wbExcel = pappExcel.Workbooks.Add(Path)
'Loop through names in the activeworkbook
  For Each xlName In wb.Names
    'if xlName's name exists in document then put the value in place of the template name
    If wbExcel.Names.Exists(xlName.Name) Then
       wbExcel.Names(xlName.Name).Range.Text = Range(xlName.Value)
    End If
  Next xlName
'Activate Excel and display document
  With pappExcel
      .Visible = True
      .ActiveWindow.WindowState = 0
      .Activate
  End With
'Release the Excel object to save memory and exit macro
ErrorExit:
   Set pappExcel = Nothing
   Exit Sub
'Error Handling routine
ErrorHandler:
   If Err Then
      MsgBox "Error No: " & Err.Number & "; There is a problem"
      If Not pappExcel Is Nothing Then
        pappExcel.Quit False
      End If
      Resume ErrorExit
   End If
End Sub

[mikerickson]

This will transfer all names in Workbook1.xls to all open workbooks.

Dim oneName As Name
For Each oneName In Workbooks("workbook1.xls").Names
    Application.Names.Add Name:=oneName.Name, RefersToR1C1:=oneName.RefersToR1C1
Next oneName

[meiklg1]

Hi,

Not quite what I was after. Basically I have a master spreadsheet for each project, which contains named cells (Including things like Project_Name, Project_Number etc). Each project I have has one of these sheets and from this I want to update a series of other worksheet templates which allready contain the same named cells with the values of the named cells from the mastersheet. Thankyou you for your reply though.