Sub SupprimerCode()
Dim chemin$, module$, macro$, texte$, fichier$, deb&, i&
chemin = ThisWorkbook.Path & "\" 'à adapter
module = "Module2" 'adaptable
macro = "Enregistre" 'adaptable
texte = "Application.Workbooks.Open ""D:\Biologie\Tableau biologique.xlsm""" 'adaptable
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier
Application.ScreenUpdating = False
On Error Resume Next 'si le module ou la macro n'existent pas
While fichier <> ""
If fichier <> ThisWorkbook.Name Then
With Workbooks.Open(chemin & fichier)
With .VBProject.VBComponents(module).CodeModule
deb = .ProcStartLine(macro, 0)
For i = deb To deb + .ProcCountLines(macro, 0) - 1
If .Lines(i, 1) = texte Then .DeleteLines i, 1: Exit For
Next
End With
.Close Not .Saved 'enregistrement et fermeture
End With
End If
fichier = Dir 'fichier suivant
Wend
End Sub
Sub SupprimerCode()
Dim chemin$, module$, macro$, texte$, fichier$, deb&, i As Variant
chemin = ThisWorkbook.Path & "\" 'à adapter
module = "Module2" 'adaptable
macro = "Enregistre" 'adaptable
texte = "Application.Workbooks.Open ""D:\Biologie\Tableau biologique.xlsm""" 'adaptable
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier
Application.ScreenUpdating = False
On Error Resume Next 'si le module ou la macro n'existent pas
While fichier <> ""
If fichier <> ThisWorkbook.Name Then
With Workbooks.Open(chemin & fichier)
With .VBProject.VBComponents(module).CodeModule
deb = .ProcStartLine(macro, 0)
For i = deb + .ProcCountLines(macro, 0) - 1 To deb Step -1
If Trim(.Lines(i, 1)) = texte Then .DeleteLines i, 1
If Left(Trim(.Lines(i, 1)), 1) = "'" Then .DeleteLines i, 1 'lignes en commentaire
Next
End With
.Close Not .Saved 'enregistrement et fermeture
End With
End If
fichier = Dir 'fichier suivant
Wend
End Sub
Tu as créé manuellement 400 fichiers ?Re,
Pour info j'ai créé 400 fichiers contenant uniquement la macro "Enregistre".
Bien sûr avec une macro (une ligne de code avec SaveAs).Tu as créé manuellement 400 fichiers ?
Sub Ouvrir
Application.Workbooks.Open "D:\Biologie\Tableau biologique.xlsm"
End sub
Sub Enregistre()
Sheets("Nouvelle").Select
ActiveWorkbook.Sheets("Nouvelle").SaveAs Filename:="D:\Biologie\Termine\" & Range("F137")
Sheets("T1").Select
Ouvrir
End Sub
Sub Ouvrir
'Application.Workbooks.Open "D:\Biologie\Tableau biologique.xlsm"
End sub