Exporter mise en page en VBA

[maryrossignon]

Bonjour le Forum,

A partir d'un classeur, le code ci-dessous me permet d'exporter des sous-totaux dans de nouveaux classeurs par responsable.

Est que quelqu'un pourrait m'aider et me dire comment modifier le code pour qu'il exporte également la mise en page du classeur de départ vers les nouveaux classeurs créés (code créé par BrunoM45) :

Sub ExportParResponsable()
  Dim DerLig As Long, Lig As Long, LigDeb As Long
  Dim NomResp As String, ShtNew As Worksheet
  Dim VPath As String
  ' Effectuer peut-être un TRI ici
  'Cells.Sort Key1:=Range("K2"), Order1:=xlAscending, _
    Key2:=Range("F2"), Order2:=xlAscending, _
    Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  ' Créer les sous-totaux
  Cells.RemoveSubtotal
  Cells.Subtotal GroupBy:=6, Function:=xlSum, TotalList:=Array(8, 9, 10), _
        Replace:=True, PageBreaks:=True, SummaryBelowData:=True
  ' Exporter chaque groupe du même responsable
  With ActiveSheet
    DerLig = .Range("F" & Rows.Count).End(xlUp).Row - 1
    LigDeb = 2: NomResp = ""
    ' Récupérer le chemin d'accès de ce classeur
    VPath = ActiveWorkbook.Path & "\"
    ' Pour chaque ligne
    For Lig = 2 To DerLig
      ' Mémoriser le nom du responsable
      If NomResp = "" Then NomResp = .Range("K" & Lig)
      ' Si la ligne contient le terme "Total"
      If InStr(1, .Range("F" & Lig), "Total") > 0 Then
        ' Vérifie si la suivante appartient au même RESPONSABLE
        If .Range("K" & Lig + 1) <> NomResp Then
          ' On crée une nouvelle feuille
          Sheets.Add After:=Sheets(Sheets.Count)
          ' On mémorise dans une variable objet
          Set ShtNew = ActiveSheet
          .Range("A1:N1,A" & LigDeb & ":N" & Lig).Copy Destination:=ShtNew.Range("A1")
          ShtNew.Name = NomResp
          ' On déplace la feuille dans un nouveau classeur
          ShtNew.Move
          ' On sauvegarde ce nouveau classeur
          ActiveWorkbook.SaveAs Filename:=VPath & NomResp & "_ECHEANCIER-CLIENTS.xlsx"
          ActiveWorkbook.Close
          ' Mémoriser la nouvelle ligne de départ
          LigDeb = Lig + 1: NomResp = ""
          ' Effacer la variable objet
          Set ShtNew = Nothing
        End If
      End If
    Next Lig
  End With
  ' Petit message
  MsgBox "Exportation terminée !", vbInformation, "Yeeessss"
End Sub

Cordialement

MaryR

 

[maryrossignon]

Re : Exporter mise en page en VBA

Re,

Veuillez trouver ci-joint un fichier en exemple, version 2007.

Cordialement