Importing Excel Macros Code from another Excel sheet which has Macro code.

Hello,

A track with the following code to copy in the code window ThisWorkbook

'### Adapt the constants ###
Const MY_WORKBOOK_SOURCE As String = "Smoke_Test.xls"
Const MY_DIR_SOURCE As String = "C:\"
'###########################

Dim objExcelSource As Workbook

Private Sub Workbook_Open()
Dim var
Set objExcelSource = GetObject(MY_DIR_SOURCE & MY_WORKBOOK_SOURCE)

          '°°° WARNING : No space in the module's name °°°
'--- To import one module ---
var = Array("TestScript")
'--- To import several modules ---
'var = Array("Result", "Datapool", "ObjectRepository")

Call CopyMacroModule(objExcelSource, var)
End Sub

Sub CopyMacroModule(SourceWB As Workbook, ModulesNames As Variant)
Dim Targetwb As Workbook
Dim strFolder As String
Dim strTempFile As String
Dim i&
Dim fso As Object
On Error GoTo PseudoErreur
If Not IsArray(ModulesNames) Then
  Error 65000
End If
Set Targetwb = ThisWorkbook
strFolder = SourceWB.Path
If Len(strFolder) = 0 Then strFolder = CurDir
strTempFile = strFolder & "\tmpexport.bas"
For i& = LBound(ModulesNames) To UBound(ModulesNames)
  SourceWB.VBProject.VBComponents(ModulesNames(i&)).Export (strTempFile)
  Targetwb.VBProject.VBComponents.Import (strTempFile)
Next i&
ThisWorkbook.Save
PseudoErreur:
If strTempFile <> "" Then
  Set fso = CreateObject("Scripting.Filesystemobject")
  MsgBox fso.FileExists(strTempFile)
  If fso.FileExists(strTempFile) = True Then Kill strTempFile
  Set fso = Nothing
End If
If Not objExcelSource Is Nothing Then
  objExcelSource.Close
  Set objExcelSource = Nothing
End If
If Err <> 0 Then
  If Err = 65000 Then
    MsgBox "ModulesNames The argument ''ModulesNames '' should be an array." & vbCrLf & _
        "ex :  var = Array(''TestScript'') OR var = Array(''Result'', ''Datapool'', ''ObjectRepository'')"
  Else
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description
  End If
End If
End Sub

I put an attachment for better understanding.
It will save Smoke_Test.xls in C: \

Best regards.

PMO
Patrick Morange