VBA 将模块从一个 Excel 工作簿复制到另一个工作簿

Question

I am trying to copy a module from one excel workbook to another using VBA.

My Code:

'Copy Macros

Dim comp As Object
Set comp = ThisWorkbook.VBProject.VBComponents("Module2")
Set Target = Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm").VBProject.VBComponents.Add(1)

For some reason, this copies the module, but does not copy the VBA code inside, why?

Please can someone show me where i am going wrong?

Thanks

Answer 1

Sub CopyModule below, receives 3 parameters:

1.Source Workbook (as Workbook ).

2.Module Name to Copy (as String ).

3.Target Workbook (as Workbook ).

CopyModule Code

Public Sub CopyModule(SourceWB As Workbook, strModuleName As String, TargetWB As Workbook)

    ' Description:  copies a module from one workbook to another
    ' example: CopyModule Workbooks(ThisWorkbook), "Module2",
    '          Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
    ' Notes:   If Module to be copied already exists, it is removed first,
    '          and afterwards copied

    Dim strFolder                       As String
    Dim strTempFile                     As String
    Dim FName                           As String

    If Trim(strModuleName) = vbNullString Then
        Exit Sub
    End If

    If TargetWB Is Nothing Then
        MsgBox "Error: Target Workbook " & TargetWB.Name & " doesn't exist (or closed)", vbCritical
        Exit Sub
    End If

    strFolder = SourceWB.Path
    If Len(strFolder) = 0 Then strFolder = CurDir

    ' create temp file and copy "Module2" into it
    strFolder = strFolder & "\"
    strTempFile = strFolder & "~tmpexport.bas"

    On Error Resume Next
    FName = Environ("Temp") & "\" & strModuleName & ".bas"
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
        Err.Clear
        Kill FName
        If Err.Number <> 0 Then
            MsgBox "Error copying module " & strModuleName & "  from Workbook " & SourceWB.Name & " to Workbook " & TargetWB.Name, vbInformation
            Exit Sub
        End If
    End If

    ' remove "Module2" if already exits in destination workbook
    With TargetWB.VBProject.VBComponents
        .Remove .Item(strModuleName)
    End With

    ' copy "Module2" from temp file to destination workbook
    SourceWB.VBProject.VBComponents(strModuleName).Export strTempFile
    TargetWB.VBProject.VBComponents.Import strTempFile

    Kill strTempFile
    On Error GoTo 0

End Sub

---

Main Sub Code (for running this code with the Post's data):

Option Explicit

Public Sub Main()

Dim WB1 As Workbook
Dim WB2 As Workbook

Set WB1 = ThisWorkbook
Set WB2 = Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")

Call CopyModule(WB1, "Module2", WB2)

End Sub

Answer 2

Fantastic Code by Chris Melville, Thanks a ton, just a few small addition which i did & added few comments.

Just make sure, following things are done before running this macro.

• VB Editor > Tools > References > (Check) Microsoft Visual Basic for Applications Extensibility 5.3

• File -> Options -> Trust Center -> Trust Center Setttings -> Macro Settings -> Trust Access to the VBA Project object model.

Once you do above thing, copy & paste below code in Source File

Sub CopyMacrosToExistingWorkbook()
'Copy this VBA Code in SourceMacroModule, & run this macro in Destination workbook by pressing Alt+F8, the whole module gets copied to destination File.
    Dim SourceVBProject As VBIDE.VBProject, DestinationVBProject As VBIDE.VBProject
    Set SourceVBProject = ThisWorkbook.VBProject
    Dim NewWb As Workbook
    Set NewWb = ActiveWorkbook ' Or whatever workbook object you have for the destination
    Set DestinationVBProject = NewWb.VBProject
    '
    Dim SourceModule As VBIDE.CodeModule, DestinationModule As VBIDE.CodeModule
    Set SourceModule = SourceVBProject.VBComponents("Module1").CodeModule ' Change "Module1" to the relevsant source module
    ' Add a new module to the destination project
    Set DestinationModule = DestinationVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
    '
    With SourceModule
        DestinationModule.AddFromString .Lines(1, .CountOfLines)
    End With
End Sub

Now run the "CopyMacrosToExistingWorkbook" macro in destination file, you will see the source file macro copied to destination file.

Answer 3

Actually, you don't need to save anything to a temporary file at all. You can use the .AddFromString method of the destination module to add the string value of the source. Try the following code:

Sub CopyModule()
    Dim SourceVBProject As VBIDE.VBProject, DestinationVBProject As VBIDE.VBProject
    Set SourceVBProject = ThisWorkbook.VBProject
    Dim NewWb As Workbook
    Set NewWb = Workbooks.Add ' Or whatever workbook object you have for the destination
    Set DestinationVBProject = NewWb.VBProject
    '
    Dim SourceModule As VBIDE.CodeModule, DestinationModule As VBIDE.CodeModule
    Set SourceModule = SourceVBProject.VBComponents("Module1").CodeModule ' Change "Module1" to the relevsant source module
    ' Add a new module to the destination project
    Set DestinationModule = DestinationVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
    '
    With SourceModule
        DestinationModule.AddFromString .Lines(1, .CountOfLines)
    End With
End Sub

Should be self-explanatory! The .AddFomString method simply takes a string variable. So in order to get that, we use the .Lines property of the source module. The first argument ( 1 ) is the start line, and the second argument is the end line number. In this case, we want all the lines, so we use the .CountOfLines property.

Answer 4

Shai Rado 的导出/导入方法的优点是可以拆分它们，即将源工作簿中的模块作为一个步骤导出，然后将它们导入到多个目标文件中！

Answer 5

I had a lot of trouble getting the previous answers to work, so I thought I'd post my solution. This function is used to programmatically copy modules from a source workbook to a newly created workbook that was also created programmatically with a call to worksheet.copy. What doesn't happen when a worksheet is copied to a new workbook is the transfer of the macros that the worksheet depends upon. This procedure iterates through all modules in the source workbook and copies them into the new one. What's more is that it actually worked for me in Excel 2016.

Sub CopyModules(wbSource As Workbook, wbTarget As Workbook)
   Dim vbcompSource As VBComponent, vbcompTarget As VBComponent
   Dim sText As String, nType As Long
   For Each vbcompSource In wbSource.VBProject.VBComponents
      nType = vbcompSource.Type
      If nType < 100 Then  '100=vbext_ct_Document -- the only module type we would not want to copy
         Set vbcompTarget = wbTarget.VBProject.VBComponents.Add(nType)
         sText = vbcompSource.CodeModule.Lines(1, vbcompSource.CodeModule.CountOfLines)
         vbcompTarget.CodeModule.AddFromString (sText)
         vbcompTarget.Name = vbcompSource.Name
      End If
   Next vbcompSource
End Sub

The function should hopefully be as simple as possible and fairly self-explanatory.