PDA

View Full Version : Transfer named cell values between workbooks



meiklg1
01-11-2008, 09:23 AM
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
01-11-2008, 06:20 PM
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
01-14-2008, 02:57 AM
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.