code vba trop long a exécuter

J

julie999

XLDnaute Occasionnel
bonjour
j'utilise un classeur excel et une macro me fait les sauvegardes
elle me copie une feuille et me l'enregistre dans un nouveau classeur a un endroit spécifier et au format choisit
ainsi de suite pour 5feuilles
j'aimerais trouver un peu d'aide afin de réduire le code vba pour qu'il s’exécute plus vite et sans ramer

en faites au lieu de me copier la feuille a chaque fois dans un nouveau classeur de l'enregistrer et de faire le classeur actif
j'aimerais un code qui m'ouvre tous les classeur en même temps qu'il enregistre une fois et me ferme tous les classeur sauf le classeur principale ou se trouve mon fichier
voici mon code

Application.ScreenUpdating = False
Sheets("RECEPTION").Copy
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ChDir "C:\Archives photobox\Reception PHOTOBOX"
ActiveWorkbook.SaveAs chemin & "Reception du " & _
Format(Worksheets("RECEPTION").Range("z2"), "d\-mm\-yyyy") & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("cross docking").Copy
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ChDir "C:\Archives photobox\Cross Docking"
ActiveWorkbook.SaveAs chemin & "Cross docking du " & _
Format(Worksheets("cross docking").Range("a4"), "d\-mm\-yyyy") & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("direct link arvato").Copy
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ChDir "C:\Archives photobox\WAY BILL Arvato"
ActiveWorkbook.SaveAs chemin & "Way Bill Arvato du " & _
Format(Worksheets("direct link arvato").Range("c15"), "d\-mm\-yyyy") & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("direct link SARTROUVILLE").Copy
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ChDir "C:\Archives photobox\WAY BILL Sartrouville"
ActiveWorkbook.SaveAs chemin & "Way Bill Sartrouville du " & _
Format(Worksheets("direct link SARTROUVILLE").Range("c15"), "d\-mm\-yyyy") & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("direct link Angleterre").Copy
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ChDir "C:\Archives photobox\WAY BILL Londres"
ActiveWorkbook.SaveAs chemin & "Way Bill Angleterre du " & _
Format(Worksheets("direct link Angleterre").Range("c15"), "d\-mm\-yyyy") & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True

End Sub
Julie
 
Trier par date Trier par votes
J

julie999

XLDnaute Occasionnel
Re : code vba trop long a exécuter

je remet le code
en faite quasiment le meme code mais 5 fois a la suite
peut etre y a t il un code plus simple


Application.ScreenUpdating = False
Sheets("RECEPTION").Copy
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ChDir "C:\Archives photobox\Reception PHOTOBOX"
ActiveWorkbook.SaveAs chemin & "Reception du " & _
Format(Worksheets("RECEPTION").Range("z2"), "d\-mm\-yyyy") & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close

Sheets("cross docking").Copy
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ChDir "C:\Archives photobox\Cross Docking"
ActiveWorkbook.SaveAs chemin & "Cross docking du " & _
Format(Worksheets("cross docking").Range("a4"), "d\-mm\-yyyy") & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close

Sheets("direct link arvato").Copy
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ChDir "C:\Archives photobox\WAY BILL Arvato"
ActiveWorkbook.SaveAs chemin & "Way Bill Arvato du " & _
Format(Worksheets("direct link arvato").Range("c15"), "d\-mm\-yyyy") & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close

Sheets("direct link SARTROUVILLE").Copy
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ChDir "C:\Archives photobox\WAY BILL Sartrouville"
ActiveWorkbook.SaveAs chemin & "Way Bill Sartrouville du " & _
Format(Worksheets("direct link SARTROUVILLE").Range("c15"), "d\-mm\-yyyy") & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close

Sheets("direct link Angleterre").Copy
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ChDir "C:\Archives photobox\WAY BILL Londres"
ActiveWorkbook.SaveAs chemin & "Way Bill Angleterre du " & _
Format(Worksheets("direct link Angleterre").Range("c15"), "d\-mm\-yyyy") & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True

End Sub
Julie
 

Pièces jointes

  • classeur test.xls
    623.5 KB · Affichages: 88
  • classeur test.xls
    623.5 KB · Affichages: 94
  • classeur test.xls
    623.5 KB · Affichages: 94
Vote positif 0 Vote négatif
L

leop93

XLDnaute Occasionnel
Re : code vba trop long a exécuter

Bonjour Julie

Voici le code dont je me sers pour sauvegarder et quitter le classeur complet lorsque je fais mon actualisation:
Code: 
'======================================================================
'Permet de sauvegarder et quitter.
'======================================================================
Sub saveAndQuit(Cancel As Boolean)
For Each w In Application.Workbooks
w.Save
Next w
Application.Quit
End Sub
Et je l'appelle de cette manière dans mon bouton d'actualisation:
Code: 
'======================================================================
'Fonction à attribuer à un bouton sur une des feuilles du classeur.
'Permet de mettre à jour en fonction des occurences choisies.
'======================================================================
Sub buttonrefresh()

Application.ScreenUpdating = False

    If MsgBox("Actualiser la base de données ?", vbQuestion + vbYesNo, "Actualisation") = vbYes Then
        
'ICI LE CODE QUE JE SOUHAITE APPLIQUER AVANT DE SAUVEGARDER ET QUITTER'

        Call saveAndQuit(False)
                
    End If
    
Application.ScreenUpdating = True

End Sub
Tu peux remplacer Application.Quit par ActiveWindow.Close je pense. ;)

Je ne programme que depuis mardi, excuse moi d'avance si ce n'est pas ce que tu voulais ou si ça ne fonctionne pas chez toi...

Leop93
 
Vote positif 0 Vote négatif
J

julie999

XLDnaute Occasionnel
Re : code vba trop long a exécuter

re
je ne pense pas que ce code puisse faire l'affaire car pour chaque feuille il m'ouvre un nouveau classeur,me copie la feuille,enregistre le classeur a l'emplacement voulu et ferme le classeur actif et il fait la même chose pour les 4 autre copie de feuille
y a t il une autre solution
Julie
 
Vote positif 0 Vote négatif
J

julie999

XLDnaute Occasionnel
Re : code vba trop long a exécuter

re le fil
personne n'a une idée
au lieu d'avoir 5 fois
ActiveWorkbook.Save
ActiveWindow.Close
est ce possible d'avoir un code pour
ActiveWorkbook.Save pour les 5 nouveaux classeur ouverts
ActiveWindow.Close pour les 5 nouveaux classeur ouverts
et conserver le classeur d'origine ouvert"classeur test"
Julie
 
Vote positif 0 Vote négatif
MJ13

MJ13

XLDnaute Barbatruc
Re : code vba trop long a exécuter

Bonjour à tous

Julie: Avec ce que tu as fait, c'est déjà bien. Je ne vois pas trop l'intérêt de réduire le code, sauf si tu es VBAccro :eek:.

Sinon, c'est long, mais cela dure combien de temps pour sauvegarder?
 
Dernière édition:
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : code vba trop long a exécuter

Bonjour à tous,
J'ai enlevé le vilain workbook open.... ... qui plantait forcément....
Une proposition :
Une macro pour boucler sur les feuilles et un routine pour copier et enregistrer les feuilles voulues
La boucle:
VB: 
Private Const Chem As String = "C:\Archives photobox\"
Sub Macro19()
Dim F As Worksheet
Application.ScreenUpdating = False
For Each F In ThisWorkbook.Worksheets
    Select Case F.Name
        Case "RECEPTION"
            Call CopiesGénérale(Sheets(F.Name), "Reception PHOTOBOX\Reception du ", F.Range("z2"))
        Case "cross docking"
            Call CopiesGénérale(Sheets(F.Name), "Cross Docking\Cross docking du  ", F.Range("A4"))
        Case "direct link arvato"
            Call CopiesGénérale(Sheets(F.Name), "WAY BILL Arvato\Way Bill Arvato du  ", F.Range("C15"))
        Case "direct link SARTROUVILLE"
            Call CopiesGénérale(Sheets(F.Name), "WAY BILL Sartrouville\Way Bill Sartrouville du ", F.Range("C15"))
        Case "direct link Angleterre"
            Call CopiesGénérale(Sheets(F.Name), "WAY BILL Londres\Way Bill Angleterre du  ", F.Range("C15"))
    End Select
Next F
Application.ScreenUpdating = True
End Sub
La routine :
VB: 
Private Sub CopiesGénérale(Sh As Worksheet, Nom As String, Rng As Range)
Dim Fin As String
Sh.Copy
Fin = Format(Sh.Range(Rng.Address), "d\-mm\-yyyy") & ".xlsm"
With ActiveWorkbook
    .UpdateLinks = xlUpdateLinksNever
    .SaveAs Chem & Nom & Fin, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    .Close False
End With
End Sub

Code testé (j'ai créé l'arboresence nécessaire)
Cordialement
 

Pièces jointes

  • classeur_test(2).zip
    213.4 KB · Affichages: 51
Dernière édition:
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : code vba trop long a exécuter

Re
Pour les ceuss que ça interresse...
On peux supprimer une variable et coder un peu plus "propre"
VB: 
Private Const Chem As String = "C:\Archives photobox\"
Private F As Worksheet
Sub Macro19()
Application.ScreenUpdating = False
For Each F In ThisWorkbook.Worksheets
    Select Case F.Name
        Case "RECEPTION"
            Call CopiesGénérale("Reception PHOTOBOX\Reception du ", _
            F.Range("Z2"))
        Case "cross docking"
            Call CopiesGénérale("Cross Docking\Cross docking du  ", _
            F.Range("A4"))
        Case "direct link arvato"
            Call CopiesGénérale("WAY BILL Arvato\Way Bill Arvato du  ", _
            F.Range("C15"))
        Case "direct link SARTROUVILLE"
            Call CopiesGénérale("WAY BILL Sartrouville\Way Bill Sartrouville du ", _
            F.Range("C15"))
        Case "direct link Angleterre"
            Call CopiesGénérale("WAY BILL Londres\Way Bill Angleterre du  ", _
            F.Range("C15"))
    End Select
Next F
Application.ScreenUpdating = True
End Sub
VB: 
Private Sub CopiesGénérale(Nom As String, Rng As Range)
Dim Fin As String
F.Copy
Fin = Format(Rng, "d\-mm\-yyyy") & ".xlsm"
With ActiveWorkbook
    .UpdateLinks = xlUpdateLinksNever
    .SaveAs Chem & Nom & Fin, FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
    CreateBackup:=False
    .Close False
End With
End Sub
Cordialement
 
Vote positif 0 Vote négatif
J

julie999

XLDnaute Occasionnel
Re : code vba trop long a exécuter

bonjour efgé ,le fil
un grand merci efgé
le temps a bien été raccourci nickel
est il possible d'y afficher une fenêtre durant la sauvegarde du style "Sauvegarde en cours veuillez patientez" et qu'elle s’enlève des que la macro de sauvegarde est terminer
Julie
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : code vba trop long a exécuter

Re,
Je pense qu'une "barre de progression" ne peut qu'allonger le temps de traitement..
Essai comme ceci, avec un message dans la barre de statut d'Excel:
VB: 
Sub Macro19()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.StatusBar = "Sauvegarde en cours..."
For Each F In ThisWorkbook.Worksheets
    Select Case F.Name
        Case "RECEPTION"
            Call CopiesGénérale("Reception PHOTOBOX\Reception du ", _
            F.Range("Z2"))
        Case "cross docking"
            Call CopiesGénérale("Cross Docking\Cross docking du  ", _
            F.Range("A4"))
        Case "direct link arvato"
            Call CopiesGénérale("WAY BILL Arvato\Way Bill Arvato du  ", _
            F.Range("C15"))
        Case "direct link SARTROUVILLE"
            Call CopiesGénérale("WAY BILL Sartrouville\Way Bill Sartrouville du ", _
            F.Range("C15"))
        Case "direct link Angleterre"
            Call CopiesGénérale("WAY BILL Londres\Way Bill Angleterre du  ", _
            F.Range("C15"))
    End Select
Next F
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "Sauvegardes terminées", 64, "Compte rendu"
End Sub
Bonne continuation.
Cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
XL 2016 Découpage Fichier Excel en plusieurs Fichiers selon une clé - VBA
Réponses
1
Affichages
2 K
fanch55
fanch55
J
  • Question
XL pour MAC code à insérer dans mon VBA pour enregistrer et archiver en pdf
Réponses
0
Affichages
894
julie13
J
T
  • Question
XL 2016 VBA - Besoin d'aide sur erreur Macro
Réponses
3
Affichages
1 K
tetchounie
T
J
  • Question
choisir son imprimante en début de macro et remettre une autre en fin de macro
Réponses
8
Affichages
8 K
Roland_M
Roland_M
J
  • Question
enregistrement classeur xlsm
Réponses
14
Affichages
43 K
julie999
J
J
  • Question
sauvegarde feuille de classeur
Réponses
5
Affichages
7 K
Gelinotte
G
S
  • Question
Problème de bouton parasitant une macro
Réponses
1
Affichages
723
jpb388
jpb388
J
  • Question
problème chemin enregistrement classeur VBA
Réponses
1
Affichages
6 K
fhoest
fhoest
J
  • Question
envoie classeur en piece jointe avec outlook 2010
Réponses
5
Affichages
37 K
Compte Supprimé 979
C
J
  • Question
incohérence sur une macro envoie email
Réponses
1
Affichages
37 K
camarchepas
camarchepas

Membres actuellement en ligne

9 membres et 85 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 196
Messages
2 086 097
Membres
103 116
dernier inscrit
kutobi87