Separer des pages en classeurs differents

[nad59165]

Bonjour,

J'ai un fichier Excel comprenant une seule feuille mais une feuille comprend plusieurs pages (196) avec un saut de pages entre chaque.
Je souhaiterai créer une macro qui sépare les pages en classeurs différents et les enregistrer sous le nom inscrit dans la première case de chaque page.
Merci pour votre aide.

 

[camarchepas]

Re : Separer des pages en classeurs differents

Bonjour ,

Comme ceci peut être ,

ATTENTION les sauts de page sont pris en compte uniquement si au moins une cellule se trouve dans cette zone

Option Explicit
Sub ff()
Dim Sp As Long, Ligne As Long, Compte As Long, Dernier As Long
Dim Pb As HPageBreak
Ligne = 1
Compte = 1
With Sheets("Feuil1")
  For Each Pb In .HPageBreaks
   Sp = Ligne
   Ligne = Pb.Location.Row
   Workbooks.Add
   .Range("A" & Sp & ":" & "Z" & Ligne - 1).Copy Destination:=Sheets("Feuil1").Range("A1")
   ActiveWorkbook.SaveAs Filename:="Coupe" & Compte
   ActiveWorkbook.Close False
   Compte = Compte + 1
  Next
  If Dernier = 0 Then
   Dernier = Ligne + Ligne - Sp
   Sp = Ligne
   Ligne = Dernier
   Workbooks.Add
   .Range("A" & Sp & ":" & "Z" & Ligne - 1).Copy Destination:=Sheets("Feuil1").Range("A1")
   ActiveWorkbook.SaveAs Filename:="Coupe" & Compte
   ActiveWorkbook.Close False

  End If
 End With
End Sub

 

[nad59165]

Re : Separer des pages en classeurs differents

Bonjour,

Merci pour cette réponse mais je ne vois pas ou s'enregistre les différents classeurs.

 

[camarchepas]

Re : Separer des pages en classeurs differents

Bonjour ,

Dans le répertoire courant , logiquement celui du classeur,

Pour spécifier le chemin modifez la ligne suivante :
Ex pour c:\temp

ActiveWorkbook.SaveAs Filename:="Coupe" & Compte

en

ActiveWorkbook.SaveAs Filename:="C:\temp\Coupe" & Compte