Move all modules to a single module

[Excelpromax123]

Hello everyone. My file has a lot of Modules I want to move to a single Module. I need the Code to run automatically (I'm currently using Cut Paste over 40 Moudles which is very time consuming). Thank you
As the example shown below: Move all the code content of 3 Moudle 1,2,3 to Moudle Home. After moving, delete modules 1,2,3. The file only has 1 Module left. The only one is Home

As the example shown below: Move all the code content of 3 Moudle 1,2,3 to Moudle Home. After moving, delete modules 1,2,3. The file only has 1 Module left. The only one is Home

 

[Gokhan Aycan]

I am not sure if this would be possible without a 3rd party app. Should be possible with UI Automation (I could read/write the code on a module using AutoIt for example. The module windows were already open though). Even another Excel macro could be used I would guess.

If you have just this workbook and, then "start copy pasting" would be my honest advice.

 

[JEC]

You can do it like this.
Make sure you test this on a copy of your workbook first.
You also have to allow access to the objectmodel of the VBA-project. File --> trust center -> macro settings --> allow... at the bottom.

Create an empty module where you want the code to be copied to. Use that name at the place where "test" stands in the code below.

Sub jec()
 For Each objMdl In ThisWorkbook.VBProject.VBComponents                                           'loop through VBcomponents
    If objMdl.Type = 1 And objMdl.Name <> "Module1" Then                                           'only copy if it's a module and not named as "module 1"
       With ThisWorkbook.VBProject.VBComponents("test")                                                  'destination of all macro's
          .CodeModule.AddFromString objMdl.CodeModule.Lines(1, objMdl.CodeModule.CountOfLines)     'copy all lines from a module to the "test" module
       End With
    End If
 Next
End Sub

 

[Excelpromax123]

You can do it like this.
Make sure you test this on a copy of your workbook first.
You also have to allow access to the objectmodel of the VBA-project. File --> trust center -> macro settings --> allow... at the bottom.

Create an empty module where you want the code to be copied to. Use that name at the place where "test" stands in the code below.

Sub jec()
 For Each objMdl In ThisWorkbook.VBProject.VBComponents                                           'loop through VBcomponents
    If objMdl.Type = 1 And objMdl.Name <> "Module1" Then                                           'only copy if it's a module and not named as "module 1"
       With ThisWorkbook.VBProject.VBComponents("test")                                                  'destination of all macro's
          .CodeModule.AddFromString objMdl.CodeModule.Lines(1, objMdl.CodeModule.CountOfLines)     'copy all lines from a module to the "test" module
       End With
    End If
 Next
End Sub

Thank you. Looks like the code is running wrong. Some module copy repeats many times. Thank you for correcting the code

Test VBA.xlsb

drive.google.com

 

[Gokhan Aycan]

I guess the if check should be for "test" not "module1"

If objMdl.Type = 1 And objMdl.Name <> "TEST" Then

As is you are not copying module1 and copying test onto itself.

 

[JEC]

You have to run this macro in a new module. Afterwards you have to exclude that module in the code. So if only this macro is in Module1, it should work. Clear TEST and try again

@GOKHAN, indeed, something like that

 

[Excelpromax123]

Bạn phải chạy macro này trong một mô-đun mới. Sau đó, bạn phải loại trừ mô-đun đó trong mã. Vì vậy, nếu chỉ có macro này trong Module1, nó sẽ hoạt động. Xóa TEST và thử lại

[USER = 20918] @GOKHAN [/ USER], thật vậy, tương tự như vậy

The code runs exactly as I intended. If you can add code to delete more Moudles 1,2,3, that would be great

Sub jec() ' Nho tao 1 moudle dat ten la  ZXCVB dung chu Hoa
 For Each objMdl In ThisWorkbook.VBProject.VBComponents                                           'loop through VBcomponents
    If objMdl.Type = 1 And objMdl.Name <> "ZXCVB" Then                                           'only copy if it's a module and not named as "module 1"
       With ThisWorkbook.VBProject.VBComponents("ZXCVB")                                                  'destination of all macro's
          .CodeModule.AddFromString objMdl.CodeModule.Lines(1, objMdl.CodeModule.CountOfLines)     'copy all lines from a module to the "test" module
       End With
    End If
 Next
 ' Delete 1,2,3 . modules

End Sub

 

[Excelpromax123]

thank you i noticed that. you can write more code to delete Modules 1,2,3 after completion

I guess the if check should be for "test" not "module1"

If objMdl.Type = 1 And objMdl.Name <> "TEST" Then

As is you are not copying module1 and copying test onto itself.

 

[JEC]

Again, test on a copy of your workbook.
You can adapt this code to your needs

Sub jec()
 For Each objMdl In ThisWorkbook.VBProject.VBComponents
   If objMdl.Type = 1 And objMdl.Name <> "Module1" And objMdl.Name <> "Test" Then
    With ThisWorkbook.VBProject.VBComponents("Test")
       .CodeModule.AddFromString objMdl.CodeModule.Lines(1, objMdl.CodeModule.CountOfLines)
       ThisWorkbook.VBProject.VBComponents.Remove objMdl
    End With
  End If
 Next
End Sub

 

[Excelpromax123]

Again, test on a copy of your workbook.
You can adapt this code to your needs

Sub jec()
 For Each objMdl In ThisWorkbook.VBProject.VBComponents
   If objMdl.Type = 1 And objMdl.Name <> "Module1" And objMdl.Name <> "Test" Then
    With ThisWorkbook.VBProject.VBComponents("Test")
       .CodeModule.AddFromString objMdl.CodeModule.Lines(1, objMdl.CodeModule.CountOfLines)
       ThisWorkbook.VBProject.VBComponents.Remove objMdl
    End With
  End If
 Next
End Sub

The code runs error. I see any Modules that are empty or named "Macro1" or "Macro2"... as error messages