Découper un fichier en plusieurs onglets

Résolu
Nonnoo Messages postés 29 Statut Membre -  
melanie1324 Messages postés 1561 Statut Membre -
Bonjour,

Je souhaite, grâce à une macro de découpage, détacher les onglets de mon fichier en plusieurs feuille car je dois distribuer chaque fichier à une personne différente.

J'ai ce code : 

Sub Découpage()

' Découpage Macro

    Dim FichierMacro
    Dim FichierCible
    Dim Chemin As String
    Dim FichierSource As String

    Application.ScreenUpdating = False
      
    Chemin = ActiveWorkbook.Path
    FichierMacro = ActiveWorkbook.Name

    FichierSource = Dir(Chemin & "\Fichiers à découper\*.xls")
   
    
    Workbooks.Open (Chemin & "\Fichiers à découper\" & FichierSource), UpdateLinks:=False
    Workbooks(FichierMacro).Activate
    
    Workbooks(FichierSource).Activate
    Sheets("GLOBAL").Select
     Application.DisplayAlerts = False
    ChDir ActiveWorkbook.Path
    For Each s In ActiveWorkbook.Sheets
     s.Copy
     ActiveWorkbook.SaveAs Filename:=s.Name
     ActiveWorkbook.Close
     Next s
     
     
    'enregistre le fichier sous
    ActiveWorkbook.CheckCompatibility = False
    ActiveWorkbook.SaveAs Filename:= _
        Chemin & "\Fichiers SX\" & FichierSource & "" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        
End Sub



Cependant je ne comprends pas, je voudrais que mes fichiers ailles dans un dossier nommé : Fichiers SX mais lorsque j'exécute ma macro, les fichiers se retrouvent dans le dossier Fichiers à découper.

Avez-vous une idée pourquoi ca ne va pas dans le bon dossier ?

Merci d'avance,

Nono

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.
A voir également:

1 réponse

Réponse 1 / 1
melanie1324 Messages postés 1561 Statut Membre 155
 
hello,

essaie ca pourr voir : 

Sub Découpage()

' Découpage Macro

    Dim FichierMacro
    Dim FichierCible
    Dim Chemin As String
    Dim FichierSource As String

    Application.ScreenUpdating = False
      
    Chemin = ActiveWorkbook.Path
    FichierMacro = ActiveWorkbook.Name

    FichierSource = Dir(Chemin & "\Fichiers à découper\*.xls")
   
    
    Workbooks.Open (Chemin & "\Fichiers à découper\" & FichierSource), UpdateLinks:=False
    Workbooks(FichierMacro).Activate
    
    Workbooks(FichierSource).Activate
    Sheets("GLOBAL").Select
     Application.DisplayAlerts = False
   
    For Each s In ActiveWorkbook.Sheets
     s.Copy
     ActiveWorkbook.SaveAs Filename:= Chemin & "\Fichiers SX\" & s.Name
     ActiveWorkbook.Close
     Next s
     
     
    'enregistre le fichier sous
    ActiveWorkbook.CheckCompatibility = False
    ActiveWorkbook.SaveAs Filename:= _
        Chemin & "\Fichiers SX\" & FichierSource & "" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        
End Sub
0