Saving input figures.
Glenn, the code I provided only did half what I assumed you were trying to
do - help you get data out of the main workbook without letting the user
save it there, and into a new workbook. And, since your ranges are so
disparate, I have had to just assume you want the data in the same cells in
the new workbook.
Whatever failings my assumptions have, consider giving more detailed
explanations of what you are trying to do in the future please.
If you insert the below code in the default module "ThisWorkbook", it should
work to intercept the Save function in Excel for the current workbook, save
the data in the ranges you described in a new workbook. It will cancel the
save function so that the first workbook does not save. That's all it does.
Note: It is touchy to work with code which interrupts the Save event
because it makes it tough to save your file in the workbook in the first
place. I suggest you make sure you open the workbook without macros enabled,
paste the code in, and save the workbook. Then close and re-open normally.
If the below doesn't do what you really are trying to do, I was just giving
you a few ideas, maybe someone else in the forum could help you.
Bill
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As _
Boolean, Cancel As Boolean)
Dim i As Long
Dim MyRange As Range
Dim MyNameIs As String
Dim wbkFrom As Workbook
Dim wbkTo As Workbook
Dim ShFrom As Worksheet
Dim ShTo As Worksheet
'Procedure here to harvest the data into a range
'For example, suppose there are
'Data in Rows 1 through 10
On Error GoTo err_Handler
'Create the workbook to actually save
Set wbkFrom = ThisWorkbook
Set ShFrom = ActiveSheet
With Workbooks.Add
Set wbkTo = ActiveWorkbook
Set ShTo = ActiveSheet
'F4:H32
Set MyRange = Range("'[" & _
wbkFrom.Name & "]" & ShFrom.Name & "'!F4:H32")
MyRange.Copy Destination:=Range("'[" & _
wbkTo.Name & "]" & ShTo.Name & "'!F4:H32")
'J24:J26
Set MyRange = Range("'[" & _
wbkFrom.Name & "]" & ShFrom.Name & "'!J24:J26")
MyRange.Copy Destination:=Range("'[" & _
wbkTo.Name & "]" & ShTo.Name & "'!J24:J26")
'N28
Set MyRange = Range("'[" & _
wbkFrom.Name & "]" & ShFrom.Name & "'!N28")
MyRange.Copy Destination:=Range("'[" & _
wbkTo.Name & "]" & ShTo.Name & "'!N28")
'L27
Set MyRange = Range("'[" & _
wbkFrom.Name & "]" & ShFrom.Name & "'!L27")
MyRange.Copy Destination:=Range("'[" & _
wbkTo.Name & "]" & ShTo.Name & "'!L27")
'C29
Set MyRange = Range("'[" & _
wbkFrom.Name & "]" & ShFrom.Name & "'!C29")
MyRange.Copy Destination:=Range("'[" & _
wbkTo.Name & "]" & ShTo.Name & "'!C29")
MyNameIs = InputBox("Where should data be stored? " & _
"it cannot be: " & vbCr & _
ThisWorkbook.Path & "\" & _
ThisWorkbook.Name, _
"Saving to a new File", ThisWorkbook.Path & "\NewName.Xls")
.SaveAs (MyNameIs)
End With
Exit_Me:
Cancel = True '''''' very important!!!
Exit Sub
err_Handler:
MsgBox Err.Description
Resume Exit_Me
End Sub
As for the second part, getting data from this file back to the template
"glenn" wrote in message
...
I am a novice at this and I copied what you wrote and pasted it in a moduel
in the workbook. Did not work. The fields I need to store a
F4:H32, J24:J26, N28, L27, C29.
You guys have helped me greatly over the months building this program.
Sorry for being so dumb to your answers. I really do that you for you
time
and help.
Glenn
"glenn" wrote:
I have built this program. Is there a way u I can save the imputed
information and not the entire templete used. Also when i want to click
on
this saved info will it load it into the templete?
THANKS GLENN
|