Je cherche =E0 d=E9velopper une macro qui cr=E9=E9e un nouveau r=E9pertoire,
selectionne cahque feuille du classeur actif, la colle dans un nouveau
classeur et enregistre ce nouveau classeur dans le r=E9pertoire cr=E9er
en lui donnant le nom de la feuille.
C'est au momenet du renommage que je bloque.
Merci par avance.
Voici le code :
Sub Creer_Dossier()
For i =3D 1 To Sheets.Count
ActiveSheet.Select
ActiveSheet.Copy
Dim fso As New FileSystemObject
If Not fso.FolderExists("C:\Documents and Settings\Classeur") Then
fso.CreateFolder "C:\Documents and Settings\Classeurs"
Dim NomClasseur
Set NomClasseur =3D Worksheets(i).Name
ChDir "C:\Documents and Settings\Classeur"
ActiveWorkbook.SaveAs Filename:=3DNomClasseur
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Ardus Petus
J'ai passablement remanié ta procédure:
Cordialement, -- AP
'------------------------------------- 'Sub Creer_Dossier() Const subdir = "C:Documents and SettingsClasseur" Dim fso As FileSystemObject Dim ws As Worksheet Dim saveNbWs As Long
Set fso = New FileSystemObject If Not fso.FolderExists(subdir) Then fso.CreateFolder subdir End If
For Each ws In Worksheets ws.Copy ActiveWorkbook.SaveAs Filename:=ws.Name ActiveWorkbook.Close Next ws
Application.SheetsInNewWorkbook = saveNbWs End Sub '----------------------------------------------
"Richard G." a écrit dans le message de news: Bonjour,
Je cherche à développer une macro qui créée un nouveau répertoire, selectionne cahque feuille du classeur actif, la colle dans un nouveau classeur et enregistre ce nouveau classeur dans le répertoire créer en lui donnant le nom de la feuille.
C'est au momenet du renommage que je bloque. Merci par avance.
Voici le code :
Sub Creer_Dossier()
For i = 1 To Sheets.Count
ActiveSheet.Select ActiveSheet.Copy Dim fso As New FileSystemObject If Not fso.FolderExists("C:Documents and SettingsClasseur") Then fso.CreateFolder "C:Documents and SettingsClasseurs"
Dim NomClasseur Set NomClasseur = Worksheets(i).Name
ChDir "C:Documents and SettingsClasseur" ActiveWorkbook.SaveAs Filename:=NomClasseur
Next i
End Sub
J'ai passablement remanié ta procédure:
Cordialement,
--
AP
'-------------------------------------
'Sub Creer_Dossier()
Const subdir = "C:Documents and SettingsClasseur"
Dim fso As FileSystemObject
Dim ws As Worksheet
Dim saveNbWs As Long
Set fso = New FileSystemObject
If Not fso.FolderExists(subdir) Then
fso.CreateFolder subdir
End If
For Each ws In Worksheets
ws.Copy
ActiveWorkbook.SaveAs Filename:=ws.Name
ActiveWorkbook.Close
Next ws
Application.SheetsInNewWorkbook = saveNbWs
End Sub
'----------------------------------------------
"Richard G." <sylvainpellletier@gmail.com> a écrit dans le message de
news:1145532387.562715.308180@t31g2000cwb.googlegroups.com...
Bonjour,
Je cherche à développer une macro qui créée un nouveau répertoire,
selectionne cahque feuille du classeur actif, la colle dans un nouveau
classeur et enregistre ce nouveau classeur dans le répertoire créer
en lui donnant le nom de la feuille.
C'est au momenet du renommage que je bloque.
Merci par avance.
Voici le code :
Sub Creer_Dossier()
For i = 1 To Sheets.Count
ActiveSheet.Select
ActiveSheet.Copy
Dim fso As New FileSystemObject
If Not fso.FolderExists("C:Documents and SettingsClasseur") Then
fso.CreateFolder "C:Documents and SettingsClasseurs"
Dim NomClasseur
Set NomClasseur = Worksheets(i).Name
ChDir "C:Documents and SettingsClasseur"
ActiveWorkbook.SaveAs Filename:=NomClasseur
'------------------------------------- 'Sub Creer_Dossier() Const subdir = "C:Documents and SettingsClasseur" Dim fso As FileSystemObject Dim ws As Worksheet Dim saveNbWs As Long
Set fso = New FileSystemObject If Not fso.FolderExists(subdir) Then fso.CreateFolder subdir End If
For Each ws In Worksheets ws.Copy ActiveWorkbook.SaveAs Filename:=ws.Name ActiveWorkbook.Close Next ws
Application.SheetsInNewWorkbook = saveNbWs End Sub '----------------------------------------------
"Richard G." a écrit dans le message de news: Bonjour,
Je cherche à développer une macro qui créée un nouveau répertoire, selectionne cahque feuille du classeur actif, la colle dans un nouveau classeur et enregistre ce nouveau classeur dans le répertoire créer en lui donnant le nom de la feuille.
C'est au momenet du renommage que je bloque. Merci par avance.
Voici le code :
Sub Creer_Dossier()
For i = 1 To Sheets.Count
ActiveSheet.Select ActiveSheet.Copy Dim fso As New FileSystemObject If Not fso.FolderExists("C:Documents and SettingsClasseur") Then fso.CreateFolder "C:Documents and SettingsClasseurs"
Dim NomClasseur Set NomClasseur = Worksheets(i).Name
ChDir "C:Documents and SettingsClasseur" ActiveWorkbook.SaveAs Filename:=NomClasseur
Next i
End Sub
Richard G.
Merci beaucoup Ardus Petus. J'ai oublié de précisé que chacune de ces feuilles ne contient qu'un seul graphiques. Et là c'est le drame ! ça ne marche plus dans ce cas là. Une idée ??
Merci beaucoup Ardus Petus. J'ai oublié de précisé que chacune de
ces feuilles ne contient qu'un seul graphiques.
Et là c'est le drame ! ça ne marche plus dans ce cas là. Une idée ??
Merci beaucoup Ardus Petus. J'ai oublié de précisé que chacune de ces feuilles ne contient qu'un seul graphiques. Et là c'est le drame ! ça ne marche plus dans ce cas là. Une idée ??
Ardus Petus
Je n'ai pas essayé, mais ça doit marcher:
'------------------------------------- Sub Creer_Dossier() Const SubDir As String = "C:Documents and SettingsClasseur" Dim fso As FileSystemObject Dim sh As Chart Dim saveNbWs As Long
Set fso = New FileSystemObject If Not fso.FolderExists(SubDir) Then fso.CreateFolder SubDir End If
For Each sh In Sheets sh.Copy ActiveWorkbook.SaveAs Filename:=sh.Name ActiveWorkbook.Close Next sh
Application.SheetsInNewWorkbook = saveNbWs End Sub '----------------------------------------------
"Richard G." a écrit dans le message de news: Merci beaucoup Ardus Petus. J'ai oublié de précisé que chacune de ces feuilles ne contient qu'un seul graphiques. Et là c'est le drame ! ça ne marche plus dans ce cas là. Une idée ??
Je n'ai pas essayé, mais ça doit marcher:
'-------------------------------------
Sub Creer_Dossier()
Const SubDir As String = "C:Documents and SettingsClasseur"
Dim fso As FileSystemObject
Dim sh As Chart
Dim saveNbWs As Long
Set fso = New FileSystemObject
If Not fso.FolderExists(SubDir) Then
fso.CreateFolder SubDir
End If
For Each sh In Sheets
sh.Copy
ActiveWorkbook.SaveAs Filename:=sh.Name
ActiveWorkbook.Close
Next sh
Application.SheetsInNewWorkbook = saveNbWs
End Sub
'----------------------------------------------
"Richard G." <sylvainpellletier@gmail.com> a écrit dans le message de
news:1145543209.870086.190240@e56g2000cwe.googlegroups.com...
Merci beaucoup Ardus Petus. J'ai oublié de précisé que chacune de
ces feuilles ne contient qu'un seul graphiques.
Et là c'est le drame ! ça ne marche plus dans ce cas là. Une idée ??
'------------------------------------- Sub Creer_Dossier() Const SubDir As String = "C:Documents and SettingsClasseur" Dim fso As FileSystemObject Dim sh As Chart Dim saveNbWs As Long
Set fso = New FileSystemObject If Not fso.FolderExists(SubDir) Then fso.CreateFolder SubDir End If
For Each sh In Sheets sh.Copy ActiveWorkbook.SaveAs Filename:=sh.Name ActiveWorkbook.Close Next sh
Application.SheetsInNewWorkbook = saveNbWs End Sub '----------------------------------------------
"Richard G." a écrit dans le message de news: Merci beaucoup Ardus Petus. J'ai oublié de précisé que chacune de ces feuilles ne contient qu'un seul graphiques. Et là c'est le drame ! ça ne marche plus dans ce cas là. Une idée ??
