View Full Version : Solved: auto-open and populate
SilverSN95
07-20-2009, 11:53 AM
I am attempting to code a macro that when a button on an excel workbook is pressed, it opens a template excel workbook from another file and pulls data from the original workbook into appropriate cells in the newly opened one.
I had my question here but I screwed up editing my post, so please see the reply below
SilverSN95
07-21-2009, 08:30 AM
So I have pieced together some code that will do what I was describing above, however I don't fully understand some of the code, if anyone could comment on whether or not this is good enough to actually use, I would appreciate it.
I am mainly concerned about using the ExcelApp object, because I don't really know what its doing besides allowing me to reference the opened workbook. Do I need to close/destroy this object at the end of the macro?
The macro ends exactly as I show it here.
Thanks.
Private Sub CommandButton3_Click()
    Dim ExcelApp As Excel.Application
    Dim dest As Excel.Workbook
    Dim SourceFile As String
    
    '*****This cell holds location of template
    SourceFile = ActiveWorkbook.Sheets("sheet2").Range("J12").Value
    On Error Resume Next
    Set ExcelApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Debug.Print Err.Description
        Err.Clear
        Set ExcelApp = CreateObject("Excel.Application")
        If Err.Number <> 0 Then
            MsgBox "Error! " & Err.Description
        End If
    End If
    Set Source = ExcelApp.ActiveWorkbook.Sheets("sheet2")
    Set dest = ExcelApp.Workbooks.Open(SourceFile)
    
    dest.Activate
'*********************************************
    With dest.Sheets("Underwriting Info")
         .Range("C7") = Source.Range("B1") 
         .Range("C9") = Source.Range("B2") 
         .Range("F9") = Source.Range("B3")
         .Range("N7") = Source.Range("B4") 
         .Range("J7") = Source.Range("B5") 
         .Range("B19") = Source.Range("B7") 
    End With
'*********************************************
End Sub
Paul_Hossler
07-21-2009, 03:11 PM
Since Excel is already open, you don't need to .Create it
 
Just use Workbooks.Open (  ), like in the sample below
 
I like to Set workbooks because IMHO it's less error prone (at least for me) to keep them streight.
 
 
 
Option Explicit
Sub Macro1()
    Const sWB2name As String = "ToBeOpened.xlsx"
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("sheet1")
    
    Call Workbooks.Open(sWB2name)
    Set wb2 = ActiveWorkbook
    Set ws2 = wb2.Worksheets("sheet1")
    
    With ws1
        .Range("A1").Value = ws2.Range("B2").Value
        .Range("A2").Value = ws2.Range("C3").Value
        .Range("A3").Value = ws2.Range("D4").Value
    End With
    
    Call wb2.Close(False)
    wb1.Activate
    Application.ScreenUpdating = True
End Sub
 
Paul
SilverSN95
07-22-2009, 06:21 AM
Thanks for the reply, that does look simpler. If my code is only using getObject instead of createObject, is there a difference in efficiency compared to your method besides how referencing the opened workbook is done?
SilverSN95
07-22-2009, 09:28 AM
Marking as solved, this is the final code I will probably use.
Private Sub CommandButton3_Click()
    Dim destWB As Workbook, sourceWB As Workbook
    Dim destWS As Worksheet, sourceWS As Worksheet
    Dim SourceFile As String
    Application.ScreenUpdating = False
    Set sourceWB = ThisWorkbook
    Set sourceWS = sourceWB.Sheets("sheet2")
    
    '*****This cell holds location of template
    SourceFile = sourceWS.Range("J12").Value
    
    Call Workbooks.Open(SourceFile)
    Set destWB = ActiveWorkbook
    Set destWS = destWB.Sheets("Underwriting Info")
    
    With destWS
    'acct profile sheet1 cell x =  cmp sheet1 cell x
         .Range("C7") = sourceWS.Range("B1")
         .Range("C9") = sourceWS.Range("B2") 
         .Range("F9") = sourceWS.Range("B3") 
         .Range("N7") = sourceWS.Range("B4") 
         .Range("J7") = sourceWS.Range("B5")
         .Range("B19") = sourceWS.Range("B7") 
    End With
    
    destWS.Activate
    Application.ScreenUpdating = True
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.