Supprimer Macros

Bonjour,

Ben, fallait copier chaque onglet desire dans un nouveau fichier, pas enregistrer le fichier sous trois noms differents en xlsm

Sub Creation_Fichier_1()
    ' Export Fichier
    Dim memPath As String   'Mémorise l'emplacement du fichier ouvert
    Dim Path As String      'Défini la variable Path
    Dim n As Long
    Dim TNom As Variant
    Dim TOnglet As Variant

    ActiveWorkbook.Save                  'sauvegarde le classeur en cours
    memPath = ThisWorkbook.FullName      'Mémorise l'emplacement du fichier
    Application.DisplayAlerts = False 'Enlève les messages d'alertes Excel
    Application.ScreenUpdating = False
        
    Path = ActiveWorkbook.Path & "\"
    TNom = Array("Mon fichier 1.xlsx", "Mon fichier 2.xlsx", "Mon fichier 3.xlsx")    'Enregistre le fichier
    TOnglet = Array("Liste Triable 1", "Liste Triable 2", "Liste Triable 3")
    
    For n = 0 To 2
        Sheets(TOnglet(n)).Copy
        With ActiveWorkbook
            .SaveAs Filename:=Path & TNom(n), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Close
        End With
    Next n
    Application.DisplayAlerts = True 'Enlève les messages d'alertes Excel
    Application.ScreenUpdating = True
End Sub

Bonjour Jordane

Merci pour ce bout de code. Malheureusement, je pense qu'il me manque encore un peu de pratique.
Ci-dessous votre code que j'ai essayé d'intégrer à mon code.

Option Explicit
Sub Création_Fichiers()
' Export Fichier
Dim memPath As String 'Mémorise l'emplacement du fichier ouvert
Dim Path As String 'Défini la variable Path
Dim nom As String
Dim nom_1 As String 'Défini la variable nom
Dim nom_2 As String
Dim nom_3 As String
Dim NomFeuille1 As String
Dim NomFeuille2 As String
Dim NomFeuille3 As String

ActiveWorkbook.Save 'sauvegarde le classeur en cours
memPath = ThisWorkbook.FullName 'Mémorise l'emplacement du fichier
Application.DisplayAlerts = False 'Enlève les messages d'alertes Excel
Application.ScreenUpdating = False

Path = ActiveWorkbook.Path & "\"
nom_1 = "Mon fichier 1" & ".xlsm" 'Enregistre le fichier
nom_2 = "Mon fichier 2" & ".xlsm"
nom_3 = "Mon fichier 3" & ".xlsm"
NomFeuille1 = "Liste Triable 1"
NomFeuille2 = "Liste Triable 2"
NomFeuille3 = "Liste Triable 3"

ActiveWorkbook.SaveAs Filename:=Path & nom_1 'Enregistre le fichier dans le dossier d'origine
ActiveWorkbook.SaveAs Filename:=Path & nom_2
ActiveWorkbook.SaveAs Filename:=Path & nom_3

Workbooks.Open Filename:=Path & nom_1
With Workbooks(nom_1)
.Sheets(Array("Liste Complete", "Cachée Tri", "Liste Triable 2", "Liste Triable 3")).Delete 'Supprime les onglets non pertinents
End With

With ActiveWorkbook.VBProject.VBComponents _
(ActiveWorkbook.Sheets(NomFeuille1).CodeName).CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With

Workbooks(nom_1).Close True

Workbooks.Open Filename:=Path & nom_2
With Workbooks(nom_2)
.Sheets(Array("Liste Complete", "Cachée Tri", "Liste Triable 1", "Liste Triable 3")).Delete 'Supprime les onglets non pertinents
.Close True
End With

'le classeur actif n'est plus celui d'origine mais: nom_3
With ActiveWorkbook
.Sheets(Array("Liste Complete", "Cachée Tri", "Liste Triable 2", "Liste Triable 1")).Delete 'Supprime les onglets non pertinents
.Save
End With

Application.DisplayAlerts = True 'Remet les alertes Excel
Application.ScreenUpdating = True

Application.Workbooks.Open memPath 'Réouvre l'emplacement du fichier qui a été mémorisé
Workbooks(nom_3).Close False 'Fermer ce classeur (la copie)
End Sub

J'ai un message qui apparait "L'accès par programme au projet VBa n'est pas fiable".

Merci pour votre aide.
Benoit

Bonjour,

Si tu souhaites surpprimer des macros (des procédures) de tes onglets (les feuilles) tu peux utiliser une macro du genre

Sub Supprimer_Code_Feuilles()

Dim NomFeuille As String
 
NomFeuille = "Feuil1"
 
With ActiveWorkbook.VBProject.VBComponents _
(ActiveWorkbook.Sheets(NomFeuille).CodeName).CodeModule
    .DeleteLines 1, .CountOfLines
    .CodePane.Window.Close
End With

Le tout pouvant être placé dans un for each pour boucler sur les différentes feuilles du classeur directement...
un truc du genre

Dim wkb As Workbook

Set wkb = Workbook("nom_du_classeur")

For Each sh In wkb.Sheets
With ActiveWorkbook.VBProject.VBComponents _
(sh.CodeName).CodeModule
    .DeleteLines 1, .CountOfLines
    .CodePane.Window.Close
End With

Next

D'autres macros utiles de suppression :
https://www.developpez.net/forums/d569894/logiciels/microsoft-office/general-vba/supprimer-macros-macro/

.