Exporter données suite à 1 saut de page entre groupe

ActiveWorkbook.SaveAs Filename:=VPath & NomResp & ".xlsx", _
            FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
            ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.SaveAs Filename:=VPath & NomResp & ".xlsx

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("L2"), Order1:=xlAscending, _
    Key2:=Range("G2"), Order2:=xlAscending, _
    Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  ' Créer les sous-totaux
  Cells.RemoveSubtotal
  Cells.Subtotal GroupBy:=7, Function:=xlSum, TotalList:=Array(9, 10, 11), _
        Replace:=True, PageBreaks:=True, SummaryBelowData:=True
  ' Exporter chaque groupe du même responsable
  With ActiveSheet
    DerLig = .Range("G" & 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("L" & Lig)
      ' Si la ligne contient le terme "Total"
      If InStr(1, .Range("G" & Lig), "Total") > 0 Then
        ' Vérifie si la suivante appartient au même RESPONSABLE
        If .Range("L" & 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:O1,A" & LigDeb & ":O" & 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 & ".xls", _
              FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
              ReadOnlyRecommended:=False, CreateBackup:=False
          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 "C'est fini !", vbInformation, "Yeeessss"
End Sub