copy "ThisWorkbook" from one file to another

[ajm]

hi all, I am trying to figure out the correct way to copy the "ThisWorkbook" module from one file to another. I have looked at Chip Pearson's website page on the topic but am still confused. If its only this one component that you wish to take to the new file, how is it done?

 

[mikerickson]

I'd use this

Dim sourceBook As Workbook
Dim destinationBook As Workbook
Dim codeFromSource As String

Set sourceBook = ThisWorkbook
Set destinationBook = Workbooks("Workbook2.xls")

With sourceBook.VBProject.VBComponents("ThisWorkbook").CodeModule
    codeFromSource = .Lines(1, .CountOfLines)
End With

With destinationBook.VBProject.VBComponents("ThisWorkbook").CodeModule
    .DeleteLines 1, .CountOfLines
    .AddFromString codeFromSource
End With

 

[ajm]

mike,

it kills excel when it gets to " .AddFromString codeFromSource". any ideas?

 

[ajm]

sorry, should supply context:

Sub PMWkBk_Creator()

'/// this macro takes a master workbook and splits it out by specific Initials in G4
'/// relies on project sheets to be bound by "First" and "Last"
'/// partners with the BACC Update to Master macro.

    Dim Sourcewb, Destwb, wkbPH, wkbMT As Workbook
    Dim wkbNV, wkbLM, wkbPA, wkbLH, wkbEM As Workbook
    Dim IncludedSheets()
    Dim x()
    ReDim x(0)
    Dim startt As Integer, endd As Integer
    Dim i As Integer
    Dim fname As String, wklyupdatefolder As String, WklyPMMailout As String
    Dim c As Variant
    Dim codeFromSource As String

    With Application
        .DisplayAlerts = False
        ' .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set Sourcewb = ThisWorkbook

    '/// Export vba Modules necessary to run BACC file
    With ThisWorkbook
        .VBProject.VBComponents("ThisWorkbook").Export ("C:\BACC_ThisWkBk.cls")
        .VBProject.VBComponents("module1").Export ("C:\BACC_MOD1.bas")
        .VBProject.VBComponents("module2").Export ("C:\BACC_MOD2.bas")
        .VBProject.VBComponents("module3").Export ("C:\BACC_MOD3.bas")
        .VBProject.VBComponents("module4").Export ("C:\BACC_MOD4.bas")
        .VBProject.VBComponents("module6").Export ("C:\BACC_MOD6.bas")
    End With

    '///declare array of necessary REPORT sheets
    IncludedSheets = Array("SAVINGS ACCUMULATOR", "Sheet Index", "Total Savings Table", "First", "Last", _
                           "Project Inception Form", "Sourcing Parameters", "CODES, LOOKUPS, ETC", _
                           "Projects Summary", "WIP", "Projects Phasing Summary")

    With Sourcewb
        '///name bookend sheets
        startt = Worksheets("First").Index + 1
        endd = Worksheets("Last").Index - 1
    End With


    '///come back to source file

    For Each c In Range("PMs")
        If c.Value = "" Then GoTo AfterArrays

        'MsgBox c.Value
        Sourcewb.Activate
        For i = startt To endd
            '///G4 holds PM initials
            If Sheets(i).Range("g4") = c Then
                x(UBound(x)) = Sheets(i).Name
                ReDim Preserve x(UBound(x) + 1)
            End If

        Next i

        ReDim Preserve x(UBound(x) - 1)

        '///add new workbook
        Sheets(IncludedSheets).Copy

        Set Destwb = ActiveWorkbook
        Application.Run "importVBA"

        With Sourcewb.VBProject.VBComponents("ThisWorkbook").CodeModule
            codeFromSource = .Lines(1, .CountOfLines)
        End With

        With Destwb.VBProject.VBComponents("ThisWorkbook").CodeModule
            .DeleteLines 1, .CountOfLines
            .AddFromString codeFromSource
        End With

        fname = Format(Now, "dd-mmm-yy") & " - " & c & " - " & Sourcewb.Name
        wklyupdatefolder = "Z:\REPORTS\006 Project Calculations\Proj Calculations 2009\Weekly Updates from PMs"
        WklyPMMailout = wklyupdatefolder & "\" & fname

        Destwb.SaveAs Filename:=WklyPMMailout
        '///change to copying both arrays to new book
        Destwb.Sheets("First").Visible = True
        Sourcewb.Sheets(x).Copy After:=Destwb.Worksheets("First")
        '///direct any links created when copying formulas back to the BACC
        Destwb.ChangeLink Name:=Sourcewb.Name _
                        , NewName:=Destwb.Name, Type:= _
                          xlExcelLinks

        ActiveWorkbook.Close (True)
        ReDim x(0)
    Next c
AfterArrays:


    '///still need to suppress range name warnings when the new c is picked up on each loop???


    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True

    End With
End Sub

Sub importVBA()
'///import necessary macros to new workbooks
    With Application.VBE.ActiveVBProject
        
        .VBComponents.Import ("C:\BACC_MOD1.bas")
        .VBComponents.Import ("C:\BACC_MOD2.bas")
        .VBComponents.Import ("C:\BACC_MOD3.bas")
        .VBComponents.Import ("C:\BACC_MOD4.bas")
        .VBComponents.Import ("C:\BACC_MOD6.bas")
    End With

End Sub

 

[mikerickson]

It might be easier to save the workbook as a different name and then delete modules.

About the code crashing Excel:
Do you have the reference MicroSoft Visual Basic for Applications Extensibility open?
It works on my Excel 2004, what version are you using?

 

[GTO]

@mikerickson:

Hi Mike

If I recall correctly, you're in MAC(?); I tried in xl2003 (WIN) and got the same crash w/and w/o 5.3. No idea why...

This seems to work:

Sub j()
 
Dim sourceBook As Workbook
Dim destinationBook As Workbook
Dim codeFromSource As String
 
'//Tested early and late-bound (removed 5.3)//
Dim DestCom As Object
Dim DestMod As Object
 
    Set sourceBook = ThisWorkbook
    Set destinationBook = Workbooks("New Microsoft Excel Worksheet (2).xls")
 
    With sourceBook.VBProject.VBComponents("ThisWorkbook").CodeModule
        codeFromSource = .Lines(1, .CountOfLines)
    End With
 
'    With destinationBook.VBProject.VBComponents("ThisWorkbook").CodeModule
    Set DestCom = destinationBook.VBProject.VBComponents("ThisWorkbook")
    Set DestMod = DestCom.CodeModule
 
    With DestMod
        .DeleteLines 1, .CountOfLines
        .AddFromString codeFromSource
    End With
End Sub

 

[ajm]

mike, yes. I have the reference checked. I am using 2003 with SP2.

and GTO, this crashed also. I copied your post below exactly. initially, it bugged out on the set destination workbook line until I opened the file "New Microsoft Excel Worksheet (2).xls". Is this because, setting a file, using only its name and not file path and directory, when its not opened causes confusion for Excel? then, it just crashed when it got to the .addfromstring line, as it did earlier.

 

[GTO]

mike, yes. I have the reference checked. I am using 2003 with SP2.

and GTO, this crashed also. I copied your post below exactly. initially, it bugged out on the set destination workbook line until I opened the file "New Microsoft Excel Worksheet (2).xls". Is this because, setting a file, using only its name and not file path and directory, when its not opened causes confusion for Excel?

...then, it just crashed when it got to the .addfromstring line, as it did earlier.

1. ...when its not open... This "problem" is not because of qualifying the fullname, but rather, that the workbook is not open. Simply put, you must first have the workbook open before you are going to write to it in any manner, whether placing vals in cells or writing to a module. Make sense?
2. Are you sure you copied the code I posted exactly and from start to finish? I simply took Mike's example and w/a minor tweak, I tested and it worked fine. Mind you, this is on my poor ol' laptop w/xl2000.

I am trying to figure out the correct way to copy the "ThisWorkbook" module from one file to another.

This is the only other thing that I can see. I believe that we were both assuming that the wb with the code in it is the wb from wherein the ThisWorkbook module is to be copied from. If you are placing the example code in a third workbook, that is to say, in a different workbook than the source 'ThisWorkbook' module, please clarify.

Hope this helps,

Mark

 

[ajm]

mark,

copied exactly. and its function is from one workbook (Sourcewb) to a second workbook (Destwb). Its in a loop mind you so the This Workbook module should be copied 6 times from the Sourcewb to the (new) DestWb. Would this have anything to do with it?

 

[ajm]

It might be easier to save the workbook as a different name and then delete modules.

i think this makes things easier. I was trying to be clever and work with arrays. thanks to you, and Mark also