VBA apply code to ThisWorkbook when sheet copied to new workbook

hajiali

Active Member
Joined
Sep 8, 2018
Messages
392
Office Version
  1. 2016
Platform
  1. Windows
VBA Code:
Sub chkDatesCopyDutyRoster()
Dim ws As Worksheet, Sh As Worksheet
Set ws = ActiveSheet
Set Sh = Sheets("BUILD")
If Sheets("Results").Range("X1") = True Then
    If DateSerial(ws.Range("H1").Value, ws.Range("E1").Value, ws.Range("F1").Value) < Sh.Range("B1").Value Or _
        DateSerial(ws.Range("H1").Value, ws.Range("E1").Value, ws.Range("F1").Value) > Sh.Range("I1").Value Then
        MsgBox "CHANGE THE DATE OF THE LAST DAY OF BID IN SHEET BID RESULTS TO CONTUINE EXPORT"
        Exit Sub
    End If
ElseIf Sheets("Results").Range("X1") = False Then
    If DateSerial(ws.Range("H1").Value, ws.Range("E1").Value, ws.Range("F1").Value) < Sh.Range("AT1").Value Or _
        DateSerial(ws.Range("H1").Value, ws.Range("E1").Value, ws.Range("F1").Value) > Sh.Range("BA1").Value Then
        MsgBox "CHANGE THE DATE OF THE LAST DAY OF BID IN SHEET BID RESULTS TO CONTUINE EXPORT"
        Exit Sub
    End If
End If
Dim wb As Workbook
Set ws = ActiveSheet
ws.Unprotect Password:="262"
ws.Copy
ws.Protect Password:="262"
With ActiveWorkbook
ws.Cells.Copy .Sheets(1).Range("A1")
    ActiveWorkbook.SaveAs fileName:= _
        "c:\" & Range("G1") & "\" & Range("F1") & ".xlsm ", FileFormat _
        :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End With
Call macro1
Call macro2
Call macro3
End Sub

Using the above code I'm able to copy the Active Sheet to its own workbook and save it to directory. I would like to add the function to copy the following code to the new workbooks "ThisWorkbook" so that when the new workbook opens anytime afterwards it runs test1 and test2

VBA Code:
Private Sub Workbook_Open()
    With Sheet1
        Call .test1
        Call .test2
    End With
End Sub

The 2 macros are Public Sub test1() and Public Sub test2() on the sheet that is being copied
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

hajiali

Active Member
Joined
Sep 8, 2018
Messages
392
Office Version
  1. 2016
Platform
  1. Windows
Not sure if it will require all that code. Maybe Im did not describe it clear but the code;

VBA Code:
Private Sub Workbook_Open()
    With Sheet1
        Call .test1
        Call .test2
    End With
End Sub

would not be in the active workbook under thisworkbook. I would have the above code as a module in the active workbook or saved on file directory as thisworkbook.cls and would like that code to be copied over to the new workbook under thisworkbook and not as a module. not sure if that clarifies or if it will require me to use the codes on the link
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,980
Fully qualify the references, using this workbook's name rather than the ThisWorkbook.
Rich (BB code):
If Workbooks("Workbook1.xlsm").Sheets("Results").Range("X1") = True Then
 

hajiali

Active Member
Joined
Sep 8, 2018
Messages
392
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

mikerickson when Im referring to thisworkbook im referring to:

1612644040868.png


the public sub() above would be in workbooks("TOOL.xlsm") as a macro however I needing another macro in workbooks("TOOL.xlsm") that I can call at the end

VBA Code:
Sub chkDatesCopyDutyRoster()

macro so that it will copy the public sub() code to the new workbook created under "thisworkbook" section in the vbaproject.

the
VBA Code:
Sub chkDatesCopyDutyRoster()
works fine
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,980
If you want code to be copied when you copy a worksheet to another workbook, you'll have to put that code in the sheet's code module.
Perhaps this work-around would work for you
VBA Code:
' in Sheet1 code module

Dim Flag As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Flag Then
        Call test1
        Call test2
        Flag = True
    End If
End Sub
 

AC PORTA VIA

Board Regular
Joined
Apr 9, 2016
Messages
89
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

not sure if you are looking for this but see below

from Programming In The VBA Editor (cpearson.com)
VBA Code:
Sub CreateEventProcedure()
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
       

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("ThisWorkbook")
        Set CodeMod = VBComp.CodeModule
       
        With CodeMod
            LineNum = .CreateEventProc("Open", "Workbook")
            LineNum = LineNum + 1
            .InsertLines LineNum, "  With Sheet1"
            LineNum = LineNum + 1
            .InsertLines LineNum, "    Call .test1"
            LineNum = LineNum + 1
            .InsertLines LineNum, "    Call .test2"
            LineNum = LineNum + 1
            .InsertLines LineNum, "  End With"
        End With
    End Sub
 
Solution

hajiali

Active Member
Joined
Sep 8, 2018
Messages
392
Office Version
  1. 2016
Platform
  1. Windows
Hello AC PORTA VIA I think what you have might be what I need. I am getting User-Defined type not defined on

VBA Code:
Dim VBProj As VBIDE.VBProject

whenever the code reaches it.
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,034
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
You need to set a reference to Microsoft Visual Basic For Applications Extensibility 5.3 as it tells you in the link.
 

hajiali

Active Member
Joined
Sep 8, 2018
Messages
392
Office Version
  1. 2016
Platform
  1. Windows
You need to set a reference to Microsoft Visual Basic For Applications Extensibility 5.3 as it tells you in the link.
Thanks Mark858 I totally miss the link got to excited about using the code. lol
 

Watch MrExcel Video

Forum statistics

Threads
1,129,285
Messages
5,635,324
Members
416,854
Latest member
jaywrye

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top