Pourquoi cette macro ne fonctionne pas?

Bonjour le forum,

Je veux recopier tous les modules d'un classeur vers un autre classeur.

Code:

Option Explicit Sub test() Dim wbs As Workbook, wbd As Workbook, v As Object, f As String Set wbs = Workbooks("Fichier Source.xls") Set wbd = Workbooks("Fichier Destination.xls") If wbd.Sheets.Count < wbs.Sheets.Count Then Exit Sub With wbs.VBProject For Each v In .VBComponents If v.Type < 4 Then f = wbs.Path & "\test." & Choose(v.Type, "bas", "cls", "frm") v.Export f wbd.VBProject.VBComponents.Import f Kill f If v.Type = 3 Then Kill Left(f, Len(f) - 1) & "x" ElseIf v.Type = 100 Then If v.CodeModule.CountOfLines > 0 Then With wbd.VBProject.VBComponents(v.CodeModule).CodeModule .DeleteLines 1, .CountOfLines .InsertLines .CountOfLines + 1, v.CodeModule.Lines(1, v.CodeModule.CountOfLines) End With End If End If Next v End With End Sub

Cocher la case : Faire confiance au projet Visual Basic => Outils Macros => Sécurité => Editeurs approuvés => Faire confiance au projet Visual Basic

Dans les Références, du VBA : Menu Outils => Références => Cocher => Microsoft Visual Basic for Applications Extensibiilty 5.3

Mon classeur cible est bien ouvert

Ça ne bug pas mais ça ne fait rien!!!

J'ai du oublier de faire quelque chose en quelque part!!!

Merci pour vos éventuelles réponses

Bonjour,

chez moi ton code fonctionne correctement. (j'ai mis ton code dans le classeur cible)

Bonsoir h2so4,

Que se passe t-il?

Peux-tu me dire stp ce que tu as dans => Outils Macros => Sécurité => Editeurs approuvés => Faire confiance au projet Visual Basic

Moi je n'ai rien.

Merci à toi

Cordialement

Je suis en version 2010 et 2013,

l'option trust vbe est activée.

j'ai testé la copie d'un module et d'une forme, je n'ai pas testé le module de classe ni le code d'une feuille.

h2so4 a écrit :

Je suis en version 2010 et 2013,

l'option trust vbe est activée.

j'ai testé la copie d'un module et d'une forme, je n'ai pas testé le module de classe ni le code d'une feuille.

Re-bonsoir h2so4,

Je crois que j'ai trouvé.

Je n'ai pas le même nombre de feuilles sur les deux classeurs.

Peut-on le contourner?

Merci à toi

Bonne fin de soirée

Bien cordialement

Bonjour le forum,

J'ai essayé de contourner le problème en mettant le même nombre de feuilles dans le classeur de destination.

Ça bloque sur la ligne du code ci-dessous:

With wbd.VBProject.VBComponents(v.CodeModule).CodeModule

Totalité du code:

Option Explicit

Sub RecopieModules()

Dim wbs As Workbook, wbd As Workbook, v As Object, f As String

Set wbs = Workbooks("TOTO.xls")

Set wbd = Workbooks("Classeur1")

If wbd.Sheets.Count < wbs.Sheets.Count Then Exit Sub

With wbs.VBProject

For Each v In .VBComponents

If v.Type < 4 Then

f = wbs.Path & "\RecopieModules." & Choose(v.Type, "bas", "cls", "frm")

v.Export f

wbd.VBProject.VBComponents.Import f

Kill f

If v.Type = 3 Then Kill Left(f, Len(f) - 1) & "x"

ElseIf v.Type = 100 Then

If v.CodeModule.CountOfLines > 0 Then

With wbd.VBProject.VBComponents(v.CodeModule).CodeModule

.DeleteLines 1, .CountOfLines

.InsertLines .CountOfLines + 1, v.CodeModule.Lines(1, v.CodeModule.CountOfLines)

End With

End If

End If

Next v

End With

End Sub

Peut-être modifier le code?

Merci d'avance pour vos éventuelles réponses

Bien cordialement

Re-Bonjour le forum,

C'est bon code différent

Bonne fin de WE à vous tous

Cordialement

Rechercher des sujets similaires à "pourquoi cette macro fonctionne pas"