Transfer named cell values between workbooks
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.
Code:
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
