VBA to Move Private Sub from one workbook to a new Workbook

Question

I want to make a VBA that will copy a Private Sub Workbook_Open from Book1 to Book2 which is a SaveAs of Book1 created with a previous VBA. I have a VBA that almost achieves this, however opening Book2 does not trigger. If there is a way to correct this program or even make the previous action of SaveAs of Book1 to make it keep the Private Sub I would love to know.

Sub CopyModule()
    Dim strModuleName As String
    Dim strFolder As String
    Dim strTempFile As String
    'Details that change depending on when the program runs
    Dim SSN As String 'Password
    Dim FULL As String 'Person's full name
    Dim wrkBkCREATOR As Workbook 'creates references for the strings to be pulled from
    Dim wrkShtCREATOR As Worksheet
    Dim wrkshtCOMPANY As Worksheet
    Dim WEEK As String 'day of the week
    Dim COMPANY As String 'company it is relevant to
    
    Set wrkBkCREATOR = Workbooks("_CREATOR.xlsm") 'major Book with information but not the one with the Macro
    Set wrkShtCREATOR = wrkBkCREATOR.Worksheets("NEW PLAYER")
    
    COMPANY = wrkShtCREATOR.Range("K8")
    
    Set wrkshtCOMPANY = wrkBkCREATOR.Worksheets(COMPANY)
    Workbooks("_CREATOR.xlsm").Activate
    
    WEEK = wrkShtCREATOR.Range("J8")
    FULL = wrkShtCREATOR.Range("F12").Value
    SSN = wrkShtCREATOR.Range("I8").Value
    
    Workbooks.Open ThisWorkbook.Path & "\" & COMPANY & " " & WEEK & "\" & FULL & ".xlsm", , , , SSN
    
    Workbooks("_NAME.xlsm").Activate              
    strFolder = Workbooks("_NAME.xlsm").Path      
    If Len(strFolder) = 0 Then strFolder = CurDir
    strFolder = strFolder & "\"
    strTempFile = strFolder & "~tmpexport.bas"
    'On Error Resume Next                          '<= disabled for Debugging purpose
    Workbooks("_NAME.xlsm").VBProject.VBComponents("ThisWorkbook").Export strTempFile 
    Workbooks(FULL & ".xlsm").VBProject.VBComponents.Import strTempFile 'Might need to simply add something to this line but I don't know
    Kill strTempFile
    On Error GoTo 0
End Sub