Découper un fichier en plusieurs onglets
Résolu
Nonnoo
Messages postés
29
Statut
Membre
-
melanie1324 Messages postés 1561 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 :
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
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. |
1 réponse
-
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
