السلام عليكم ورحمه الله وبركاته
هذا هو الكود ولكن كل المحاولات بائت بالفشل
CODE
Sub Copy_Worksheet_Module_To_Multiple_Closed_Workbooks()
Dim src, dest, wb As Workbook, strFolder As String, strFile As String, i As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
'Change Sheet1 With Source Worksheet Name
Set src = ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
strFolder = ThisWorkbook.Path & "new"
strFile = Dir(PathName:=strFolder & "*.xls*")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strFolder & strFile)
For i = 1 To wb.Worksheets.Count
'Change Sheet1 With Target Worksheet Name
Set dest = wb.VBProject.VBComponents(i).CodeModule
Do While dest <> "module1" And dest <> "ThisWorkbook"
dest.DeleteLines 1, dest.CountOfLines
dest.AddFromString src.Lines(1, src.CountOfLines)
Loop
Next i
wb.Close SaveChanges:=True
strFile = Dir
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Done...", 64
End Sub