Créations Fichiers Résolu/Fermé

Question

Bonsoir,


J'ai un fichier avec plusieurs onglets. Je cherche à enregistrer trois de ces onglets (ici je les ai nommé Liste triable 1, liste triable 2, liste triable 3) dans un nouveau fichier. Chacun le sien.
L'attribution du nom personnalisé = ca s'est fait
Enregistrement = ca s'est fait 

Pour enlever les onglets nécessaires, j'ai écrit un bout de code.
J'enregistre trois nouveaux fichiers, je les réouvre, j'enlève les onglets en trop dans chacun des fichiers, je les referme et retourne sur le fichier d'origine.

Seulement, la macro s'arrete au moment de supprimer les onglets dans le fichier 3, les deux autres fichiers s'étant bien enregistrés et ont bien les onglets excédentaires supprimés.


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

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"
        
    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
    Sheets(Array("Liste Complete", "Cachée Tri", "Liste Triable 2", "Liste Triable 3")).Delete 'Supprime les onglets non pertinents
    ActiveWorkbook.Close True
    
    Workbooks.Open Filename:=Path & nom_2
    Sheets(Array("Liste Complete", "Cachée Tri", "Liste Triable 1", "Liste Triable 3")).Delete 'Supprime les onglets non pertinents
    ActiveWorkbook.Close True
    
    Workbooks.Open Filename:=Path & nom_3
    Sheets(Array("Liste Complete", "Cachée Tri", "Liste Triable 2", "Liste Triable 1")).Delete 'Supprime les onglets non pertinents
     
    Application.DisplayAlerts = True 'Remet les alertes Excel
    Application.ScreenUpdating = True
         
    ActiveWorkbook.Save                  'sauvegarde le classeur en cours
    Application.Workbooks.Open memPath  'Réouvre l'emplacement du fichier qui a été mémorisé
    ThisWorkbook.Close False            'Fermer ce classeur (la copie)
    
    End Sub
    

Merci à vous par avance pour une solution

f894009 · Answer

Bonjour,

Seulement, la macro s'arrete au moment de supprimer les onglets dans le fichier 3
Non, si vous ne mettez Application.DisplayAlerts = False en commentaire vous avez une erreur. Votre code corrige (une facon de faire)

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

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"
        
    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
        .Close True
    End With
    
    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

Créations Fichiers

1 réponse

Discussions similaires