VBA to copy Module from one Excel Workbook to another Workbook

前端 未结 5 1857
猫巷女王i
猫巷女王i 2020-12-29 12:16

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.VBProje         


        
相关标签:
5条回答
  • 2020-12-29 12:55

    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.

    0 讨论(0)
  • 2020-12-29 13:05

    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.

    0 讨论(0)
  • 2020-12-29 13:07

    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.

    0 讨论(0)
  • 2020-12-29 13:12

    Shai Rado's method of export/import has the advantage that you can split them, i.e. export the module from the source workbook as one step and then import them into multiple target files!

    0 讨论(0)
  • 2020-12-29 13:18

    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
    
    0 讨论(0)
提交回复
热议问题