copie de plusieurs feuille divers enpalcements

BOnsoir n

j'utilise la macro ci-dessous pour enregistrer un feuille a un
emplacement et j'aimerais savoir s'il est possbile d'enregistrer des
feuilles a des emplacements different, je m'explique :
1 classeur avec 4 feuilles et j'amerais enregistrer la feuille 1 sur c:
feuill1 la feuille 2 sur c:feuill2 etc avec un nom de classuer
pour chaque feuille contenu dans la cellule A1 de chaque feuille.

merci de votre aide.

macro :
Sub Exportlotissement()
Dim Cl As Workbook
Dim Fe1 As Worksheet
Set Fe1 = Worksheets("Lotissement")
Application.ScreenUpdating = False
Set Cl = Workbooks.Add
With Cl
.SaveAs ("c:" & "nom_Lotissement" & ".xls")
Fe1.Copy .Worksheets("Feuil1")
ActiveSheet.Name = "Lotissement"
Application.DisplayAlerts = False
.Worksheets("Feuil1").Delete
.Worksheets("Feuil2").Delete
.Worksheets("Feuil3").Delete
.Worksheets("Feuil4").Delete
Application.DisplayAlerts = True
.Save
.Close
End With
Application.ScreenUpdating = True
Set Fe1 = Nothing
Set Fe2 = Nothing
Set Fe3 = Nothing
Set Cl = Nothing
End Sub

bonjour sleg,

ChDir "c:"
For Each f In Worksheets
  f.Select
  MkDir f.Name
  f.Copy
  ActiveWorkbook.SaveAs Filename:="C:" & f.Name & "" & Range("A1") &
".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword: ="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
   ActiveWorkbook.Close
 Next

isabelle

sleg a écrit :



> BOnsoir n

> j'utilise la macro ci-dessous pour enregistrer un feuille a un
> emplacement et j'aimerais savoir s'il est possbile d'enregistrer des
> feuilles a des emplacements different, je m'explique :
> 1 classeur avec 4 feuilles et j'amerais enregistrer la feuille 1 sur c:
> feuill1 la feuille 2 sur c:feuill2 etc avec un nom de classuer
> pour chaque feuille contenu dans la cellule A1 de chaque feuille.

> merci de votre aide.

> macro :
> Sub Exportlotissement()
> Dim Cl As Workbook
> Dim Fe1 As Worksheet
> Set Fe1 = Worksheets("Lotissement")
> Application.ScreenUpdating = False
> Set Cl = Workbooks.Add
> With Cl
> .SaveAs ("c:" & "nom_Lotissement" & ".xls")
> Fe1.Copy .Worksheets("Feuil1")
> ActiveSheet.Name = "Lotissement"
> Application.DisplayAlerts = False
> .Worksheets("Feuil1").Delete
> .Worksheets("Feuil2").Delete
> .Worksheets("Feuil3").Delete
> .Worksheets("Feuil4").Delete
> Application.DisplayAlerts = True
> .Save
> .Close
> End With
> Application.ScreenUpdating = True
> Set Fe1 = Nothing
> Set Fe2 = Nothing
> Set Fe3 = Nothing
> Set Cl = Nothing
> End Sub- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -