Sub Copier_UserForms_Modules_ThisWorkbook()
Dim chemin$, fichier$, vbc As Object, i%, a$(), n%, code$, wb As Workbook, nom$, j
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier'à adapter
Application.ScreenUpdating = False
'---crée les fichiers .frm et .frx---
Set vbc = ThisWorkbook.VBProject.VBComponents
For i = 1 To vbc.Count
If vbc(i).Type <= 3 Then 's'il s'agit d'un UserForm ou d'un module
ReDim Preserve a(2, n) 'base 0
a(0, n) = vbc(i).Name 'mémorise le nom
a(1, n) = chemin & n & ".frm"
a(2, n) = chemin & n & ".frx"
vbc(i).Export a(1, n) 'le fichier frx pour les UserForms se crée en même temps
n = n + 1
End If
Next i
'---code du ThisWorkbook---
With vbc(ThisWorkbook.CodeName).CodeModule
code = .Lines(1, .CountOfLines)
End With
While fichier <> ""
If fichier <> ThisWorkbook.Name Then 'sauf le fichier source
Application.EnableEvents = False 'désactive les évènements (Workbook_Open)
Set wb = Workbooks.Open(chemin & fichier)
Application.EnableEvents = True 'réactive les évènements
Set vbc = wb.VBProject.VBComponents
'---importe les fichiers .frm---
For i = 0 To n - 1
nom = LCase(a(0, i))
For j = 1 To vbc.Count
If vbc(j).Type <= 3 Then If LCase(vbc(j).Name) = nom Then vbc.Remove vbc(j): Exit For 'supprime l'élément de même nom s'il existe
Next j
vbc.Import a(1, i)
Next i
'---importe le code du ThisWorkbook---
With vbc(wb.CodeName).CodeModule
.DeleteLines 1, .CountOfLines 'RAZ
.InsertLines 1, code
End With
'---enregistre et ferme le fichier---
wb.Close True
End If
fichier = Dir 'fichier suivant
Wend
'---supprime les fichiers .frm et .frx---
For i = 0 To n - 1
Kill a(1, i)
If Dir(a(2, i)) <> "" Then Kill a(2, i)
Next i
End Sub