PDA

View Full Version : Solved: Save specific cells in Excel with a Macro



hk43m
07-15-2008, 02:34 AM
Hi all,

Thanks for this forum which help me everyday :bow: .
Actually, I have a query for a macro that I cannot find at the moment.

I want to save specific cells from an Excel sheet to whatever data format.
There are many inputs in this sheet which are used for a final calculation.
I would like to save the inputs in a separate file in order to be able to load them if I have to modify some of the former information (inputs).

So I need 2 macros : the first one is to save the inputs and the second one is to load them if I need.

I already use the macro "TwoSheetsAndYourOut" by Justin, it works perfectly and I think it could be a template (but I'm not at all a VBA writer) but now this is about saving only specific cells and not a whole sheet.
I don't know if it's possible...

Thanks for your help.

HK43M

Bob Phillips
07-15-2008, 02:47 AM
Just copy the specific cells off to a blank sheet and save that sheet (however that application does that).

hk43m
07-15-2008, 03:26 AM
Thanks for your quick reply xld.

Actually, I think I need a macro because there will be a lot of different cases with different inputs and I don't want to have to copy these information for each one. So, with a macro and a command button, it should be easier.
Plus, I need the different information to be load in the same cells they were before I saved them in order to be able to modify them.

Thanks
HK43M

Bob Phillips
07-15-2008, 03:46 AM
I was thinking of a macro, I just outlined the steps. YOu could record such a macro when doing in Excel.

hk43m
07-15-2008, 06:10 PM
Yes exactly, and make the sheet and, above all, the information in it available for a possible future copy&paste to the original sheet (with the calculation formula) and in the same cells...

Thank you for your help :-)

I have found something on the Internet for the second task : load (or export) data to specific cells/fields in a specific sheet.
But I cannot make it work...:

Public Sub CopyRs2Sheet(strSql As String, strWorkBook As String, _
Optional strWorkSheet As String, Optional strCellRef
As String)
'Uses the Excel CopyFromRecordset method
'strSql: Select string
'strWorkBook: Full path and name to target wb, will create if doesn't
exist
'strWorkSheet: Name of target worksheet, will create if doesn't exist
'strCellRef: Upper Left cell for data, defaults to A1


On Error GoTo ProcError
DoCmd.Hourglass True

'using late binding on Excel
Dim objXLApp As Object 'Excel.Application
Dim objXLWb As Object 'Excel.Workbook
Dim objXLSheet As Object 'Excel.Worksheet
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Dim i As Integer
Dim iSheets As Integer

'set rs from sql, table or query
Set rs = CurrentDb.OpenRecordset(strSql, dbOpenSnapshot)

'start Excel
Set objXLApp = CreateObject("Excel.Application")

'open workbook, error routine will
'create it if doesn't exist

'only create workbooks with 1 sheet
iSheets = objXLApp.SheetsInNewWorkbook 'save user's setting
objXLApp.SheetsInNewWorkbook = 1 'set for only 1 sheet
Set objXLWb = objXLApp.Workbooks.Open(strWorkBook)
objXLApp.SheetsInNewWorkbook = iSheets 'restore user's setting

'select a worksheet, if sheet doesn't exist
'the error routine will add it
If strWorkSheet = "" Then
strWorkSheet = "Sheet1"
End If

'If Range is missing default to A1
If strCellRef = "" Then
strCellRef = "A1"
End If

'select desired worksheet
Set objXLSheet = objXLWb.Worksheets(strWorkSheet)

'insert recordset into Excel Worksheet using CopyFromRecordset method
objXLSheet.Range(strCellRef).CopyFromRecordset rs
objXLSheet.Columns.AutoFit

'Save wb
objXLWb.Save
objXLWb.Close

'close up other rs objects
If Not rs Is Nothing Then rs.Close
Set rs = Nothing

Set objXLSheet = Nothing
Set objXLWb = Nothing

'quit Excel
If Not objXLApp Is Nothing Then objXLApp.Quit
Set objXLApp = Nothing

DoCmd.Hourglass False
Exit Sub

ProcError:

Select Case Err
Case 9 'Worksheet doesn't exist
objXLWb.Worksheets.Add
Set objXLSheet = objXLWb.ActiveSheet
objXLSheet.NAME = strWorkSheet

Resume Next

Case 1004 'Workbook doesn't exist, make it
objXLApp.Workbooks.Add
Set objXLWb = objXLApp.ActiveWorkbook
objXLWb.SaveAs strWorkBook

Resume Next

Case Else
DoCmd.Hourglass False
MsgBox Err.Number & " " & Err.Description
Stop
Resume 0
End Select

End Sub

Bob Phillips
07-16-2008, 01:22 AM
That looks like Access code.

I would do something like this. You will need to build on it, but this is the basis.



Set sh = Activesheet
Set wb = Workbooks.Add

With Activesheet

.Range("A5").Copy wb.Worksheets(1).Range("A5")
.Range("M2:N10").Copy wb.Worksheets(1).Range("M2")

'etc.
End With

wb.SaveAs "C:\mydir\mfile.xls"

hk43m
07-16-2008, 02:21 AM
Thank you very much for this,
I'm trying to make it work but I'm not sure about the variable type, can you specify please?

Thanks

Bob Phillips
07-16-2008, 02:45 AM
What variable type?

hk43m
07-16-2008, 02:54 AM
These ones:
Set sh = Activesheet
Set wb = Workbooks.Add

Thanks

Bob Phillips
07-16-2008, 04:09 AM
So what are you not sure about? Seems straight-forward to me.

hk43m
07-16-2008, 06:20 PM
Well, about how to use the macro you wrote. I'm a beginner in VBA so when you write "You will need to build on it, but this is the basis" I don't know how to start... For example:
- do I write Option Explicit
Sub name of the macro()
Dim ... As ...
etc.

Thank you for your help and your time, I really appreciate.
I've learnt a lot of things here but not I'm currently not able to write something :-(

hk43m
07-17-2008, 01:20 AM
Using your macro xld and other formula, this is what I have, which does not work... It create a new one sheet workbook but doesn't paste the values I have copied. Actually, it only selects the cells D3: D13 but doesn't input anything in it.

Option Explicit
Sub SaveTheCells()
Dim NewName As String
Dim ws As Worksheet
Dim aWb As Workbook
Dim aWS As Worksheet
Set aWb = Workbooks.Add(1)
Set aWS = aWb.ActiveSheet


With ActiveSheet
.Range("B3:B13").Copy
aWS.[B3].PasteSpecial Paste:=xlValues
.Range("D3: D13").Copy
aWS.[D3].PasteSpecial Paste:=xlValues
End With

NewName = InputBox("Please Specify the name of your new workbook", "New Copy")
aWb.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
aWb.Close SaveChanges:=False
End Sub

Thanks for your help,
I hope that I seem less freeloader :-)

Bob Phillips
07-17-2008, 01:33 AM
Your code is getting confused with what is the activesheet, as soon as you add a workbook, that becoes the activesheet, so you need to catch it before then



Sub SaveTheCells()
Dim NewName As String
Dim ws As Worksheet
Dim aWb As Workbook
Dim aWS As Worksheet

Set ws = ActiveSheet
Set aWb = Workbooks.Add(xlWBATWorksheet)
Set aWS = ActiveSheet

With ws
.Range("B3:B13").Copy
aWS.Range("B3").PasteSpecial Paste:=xlValues
.Range("D3: D13").Copy
aWS.Range("D3").PasteSpecial Paste:=xlValues
End With

NewName = InputBox("Please Specify the name of your new workbook", "New Copy")
aWb.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
aWb.Close SaveChanges:=False
End Sub

hk43m
07-17-2008, 02:03 AM
:-) It works very well and as I want with your updates
It's really perfect

Thank you very much

Now I have to think about how to reach and load these cells in the original workbook and sheet, which should be the inverse operation...
Can you tell me if the code in the reply#5 is good?

Thanks again, I became a VB addict :hi:

Bob Phillips
07-17-2008, 02:26 AM
I am afraid I ditched looking at #5 very quickly as it seemed overly-complex, and Access related.

You seem toi be getting on okay, take a crack at modifying what we jhave, and post if you get stuck.

hk43m
07-17-2008, 02:41 AM
Yeah sure,

I'll post anyway if I find something by myself... lol

Thank you again, your help was priceless.