Créations Fichiers

Résolu
Benoit_Lyon Messages postés 99 Statut Membre -  
Benoit_Lyon Messages postés 99 Statut Membre -
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

1 réponse

Réponse 1 / 1
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
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
0
Benoit_Lyon Messages postés 99 Statut Membre 1
 
Bonjour,

Je vous remercie pour cette réponse qui fonctionne à merveille.
Maintenant par curiosité personnel, et afin que je puisse intégrer cette technique, pouvez-vous m'expliquer la différence entre nos deux méthodes ?
Est-ce que c'est juste parce que j'avais oublié que le fichier 3 était du coup le dernier ouvert, ou la méthode With, End With a changé quelque chose ? (Largement plus esthétique, j'en convient).

Merci à vous.
Benoit
0
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715 > Benoit_Lyon Messages postés 99 Statut Membre
 
Re,

Est-ce que c'est juste parce que j'avais oublié que le fichier 3 était du coup le dernier ouvert,
Oui, c'est l'unique raison

ou la méthode With, End With a changé quelque chose ? (Largement plus esthétique, j'en convient).
Ce n'est pas de l'esthetisme, le code s'execute plus rapidement. Ici, ce n'est pas capital, mais dans beaucoup d'autres cas c'est interessant
0
Benoit_Lyon Messages postés 99 Statut Membre 1
 
Merci à vous
0