Copier tous les modules d'une feuille vers un new classeur

Bonjour a tous,

Voila je suis un peu novice dans vba mais j'ai une derniere chose a faire dans mon fichier afin de le finir et je n'y arrive pas.

Sur le classeur 1 j'ai une feuille2 qui a plusieurs macro (boutons avec modules) que je copie via macro en creant un nouveau classeur.

Le pb est que tout se passe bien sauf que je n'arrive à copier que 1 seul module mais pas tous.

Mes modules vont de 11 à 19, je vous mets se que j'ai en bas.

Je vous ai mis toute la macro mais la ou j'ai le soucis se trouve à la fin en rouge

Si vous pouvez m'aider merci d'avance à vous tous.

Sub EnvoiMail10()

Dim ret As Integer

ret = MsgBox("Voulez-vous valider?", vbYesNo, "Demande de confirmation")

If ret = vbYes Then

End If

If ret = vbNo Then

Exit Sub

End If

Dim OutApp As Object

Dim OutMail As Object

Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

strbody = "<font size=""3"" face=""Calibri"">" & _

"Bonjour,<br><br>" & _

"Nouvelle demande de purge et conditionnement de circuit." & _

"<br><br>Cliquez sur ce lien pour ouvrir le fichier concerné : " & _

"<A HREF=""fichier" & _

""">ici</A>" & _

"<br><br>Cordialement," & _

"<br><br>L'Équipe ML Labo</font>"

On Error Resume Next

With OutMail

.To = "email"

.CC = ""

.BCC = ""

.Subject = "Demande de purge et conditionnement de circuit"

.HTMLBody = strbody

.Send

End With

On Error GoTo 0

Set OutMail = Nothing

Set OutApp = Nothing

Dim chemin As String

Nom = [K2]

Sheets("FTE").Copy

chemin = "C:\Users\Desktop\ML labo - EX\FTE\"

ActiveWorkbook.SaveAs Filename:=chemin & "FTE n°" & Nom

Dim sh As Worksheet

For Each sh In Worksheets

sh.EnableAutoFilter = True

sh.EnableOutlining = True

sh.Protect Contents:=True, Password:="3110", UserInterfaceOnly:=True

Next

Dim NewM As Object, NewCode As String

With ThisWorkbook.VBProject.VBComponents("Module11").CodeModule

NewCode = .Lines(1, .CountOfLines)

End With

Set NewM = ActiveWorkbook.VBProject.VBComponents.Add(1)

With ActiveWorkbook.VBProject.VBComponents(NewM.Name).CodeModule

.DeleteLines 1, .CountOfLines

.AddFromString NewCode

End With

End Sub

Bonjour,

Pourquoi ne pas faire une boucle sur tes modules ?

A tester chez toi.

Dim NewM As Object, NewCode As String
For i = 11 to 19
With ThisWorkbook.VBProject.VBComponents("Module" & i).CodeModule
NewCode = .Lines(1, .CountOfLines)
End With

Set NewM = ActiveWorkbook.VBProject.VBComponents.Add(1)
With ActiveWorkbook.VBProject.VBComponents(NewM.Name).CodeModule
.DeleteLines 1, .CountOfLines
.AddFromString NewCode
End With
Next i

A plus

Super ca marche merci beaucoup

c'est le for i qui me posait pb ou le placer...

Merci encore de ton aide