Excel aide sur premiere macro debutante

mellesun Messages postés 4 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Grace à la commauté, j'ai reussi à reconstruire par logique une MACRO mais celle ci plante à la moitié, et mon niveau ne me permet pas de comprendre comment deboguer.
Merci à ceux qui pourront m'aider, voici ma macro, elle sert à séparer les onglets pour mettre dans un dossier a date sur le bureau. Les onglets se dispatchent sur le bureau ( à moitié ) mais le dossier n'est pas créer sur le bureau. Ensuite ca bogue. ( en rouge)
quand je supprime cette partie que j'ai pris sans vraiment savoir peut etre la macro ne fonctionne plus?

un grand MERCI à ceux qui pourront m'aider à résoudre ce problème, c'est ma toute première macro :-) 


Sub dispatch_Une_Par_Une()
Dim chemin As String, F As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
chemin = CreateObject("WScript.Shell").specialFolders("Desk top")
chemin = chemin & "\" & Format(Date, "yyyy_mm_dd")
For Each F In Worksheets
F.Copy
With ActiveWorkbook
.SaveAs Filename:=chemin & "\" & .ActiveSheet.Name & ".xlsx"
.Close True
End With
Next F
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
A voir également:

2 réponses

Réponse 1 / 2
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour, 

Sub dispatch_Une_Par_Une()
    Dim chemin As String, F As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    chemin = CreateObject("WScript.Shell").specialFolders("Desktop")
    chemin = chemin & "\" & Format(Date, "yyyy_mm_dd")
    MkDir chemin        'creation du repertoire
    For Each F In Worksheets
        F.Copy
        With ActiveWorkbook
            .SaveAs Filename:=chemin & "\" & .ActiveSheet.Name & ".xlsx"
            .Close True
        End With
    Next F
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
0
Réponse 2 / 2
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Re,

mieux avec test si repertoire existe 

Sub dispatch_Une_Par_Une()
    Dim chemin As String, F As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    chemin = CreateObject("WScript.Shell").specialFolders("Desktop")
    chemin = chemin & "\" & Format(Date, "yyyy_mm_dd")
    
    If Dir(chemin, vbDirectory) = "" Then   'repertoire n'existe pas
        MkDir chemin        'creation du repertoire
    End If
    For Each F In Worksheets
        F.Copy
        With ActiveWorkbook
            .SaveAs Filename:=chemin & "\" & .ActiveSheet.Name & ".xlsx"
            .Close True
        End With
    Next F
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
0
mellesun Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour
je te remercie beaucoup pour ton aide je vais essayer, en fait j'ai + de 100 onlgelt a mettre dans un dossier sur le bureau; UN GRAND MERCI je teste et te dit ca
0
mellesun Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
 
La macro a marché mais pas entierement, la création du dossier daté sur le bureau est OK, ensuite, il y a le dispatch mais pas de tous les onglets.
Le code met une erreur à F.Copy?
As tu une idée pour déboguer? MERCI
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > mellesun Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,
Vu le nombre de création fichier, il serait bien de temporiser en ajoutant une ligne juste devant le Next F:
Application.Wait(Now+Timevalue("00:00:01"))
0

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses