intercaler feuille lors de l'impression

Sub ImprimerFeuille()
  Dim Rng As Range
  ' Définir la zone des cellules dont la couleur est à changer
  Set Rng = Range("C14,F30,C46,F53")
  ' Supprimer la couleur avant impression
  Rng.Interior.ColorIndex = xlNone
  ' Lancer l'impression des 3 premières pages
  Sheets("OPTIMISATION").PrintOut From:=1, To:=3, Copies:=1, Collate:=True
  ' Lancer l'impression de la page intermédiaire
  Sheets("g9échéancier").PrintOut Copies:=1, Collate:=True
  ' Continuer l'impression du reste des pages
  Sheets("OPTIMISATION").PrintOut From:=4, Copies:=1, Collate:=True
  ' Remettre la couleur des cellules
  Rng.Interior.ColorIndex = 36
End Sub

Set Rng = Range("R17,V17,N18,N19,N20,N21,N23,N31,N33",  _
"R33,V78,N83,N84,N85,N86,N87,A87,A88,N88", _ 
Etc ....

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String _
    , ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Sub ImpressionsMultiplesVers1PDF()
  Dim pdfjob As PDFCreator.clsPDFCreator
  Dim sPDFPath As String, sPDFName As String
  Dim Rng As Range, Rng1 As Range
  Dim Hndl As Long
  '
  ' Chemin de destination
  sPDFPath = ThisWorkbook.Path & Application.PathSeparator
  ' Fichier de destination
  sPDFName = "TempPDF.pdf"
  ' Créer une instance de PDFCreator
  Set pdfjob = New PDFCreator.clsPDFCreator
  ' Avec cette instance
  With pdfjob
    If .cStart("/NoProcessingAtStartup") = False Then
      MsgBox "Can't initialize PDFCreator.", vbCritical + _
                                             vbOKOnly, "PrtPDFCreator"
      Exit Sub
    End If
    .cOption("UseAutosave") = 1
    .cOption("UseAutosaveDirectory") = 1
    .cOption("AutosaveDirectory") = sPDFPath
    .cOption("AutosaveFilename") = sPDFName
    .cOption("AutosaveFormat") = 0  ' 0 = PDF
    .cClearCache
  End With
  ' Définir l'imprimante PDFCreator par défaut
  Application.ActivePrinter = "PDFCreator sur Ne00:"
  ' Définir la zone des cellules dont la couleur est à changer
  Set Rng = Range("R17,V17,N18,N19,N20,N21,N23,N31,N33," _
                & "R33,V78,N83,N84,N85,N86,N87,A87,A88,N88," _
                & "N90,R90,V90,N94,A94,A95,N95,A96,N96,N101,N107,A109,N109,N112")
  ' Faire en 2 partie sinon BUG
  Set Rng1 = Range("R112,V112,N114,R114,V114,N123,R123,V123,N124,R124,V124,R130,N130,V130,A131," _
                 & "N131,R131,V131,N134,R134,A137,N137,R137,V137,A138,N138," _
                 & "R138,V138,A139,N139,R139,V139")
  ' Supprimer la couleur avant impression
  Rng.Interior.ColorIndex = xlNone
  Rng1.Interior.ColorIndex = xlNone
  ' Lancer l'impression des 3 premières pages
  Sheets("OPTIMISATION").PrintOut From:=1, To:=3, Copies:=1, Collate:=True
  ' Lancer l'impression de la page intermédiaire
  Sheets("g9échéancier").PrintOut Copies:=1, Collate:=True
  ' Continuer l'impression du reste des pages
  Sheets("OPTIMISATION").PrintOut From:=4, Copies:=1, Collate:=True
  ' Combiner tous les fichiers en SPOOL
  pdfjob.cCombineAll
  ' Remettre la couleur des cellules
  Rng.Interior.ColorIndex = 36
  Rng1.Interior.ColorIndex = 36
  ' Attendre que le Job entre dans le spool d'impression
  Do Until pdfjob.cCountOfPrintjobs = 1
    DoEvents
  Loop
  pdfjob.cPrinterStop = False
  ' Attendre que le job soit imprimé (fichier enregistré)
  Do Until pdfjob.cCountOfPrintjobs = 0
    DoEvents
  Loop
  pdfjob.cClose
  Set pdfjob = Nothing
  ' Sélectionner l'imprimante par défaut
  Application.ActivePrinter = _
  "\\sficmontargis01\RICOH Aficio MP C2500 RPCS Haut sur Ne06:"
  ' Lancer l'impression du document sur l'imprimante souhaitée
  Hndl = FindWindow("XLMAIN", Application.Caption)
  ShellExecute Hndl, "print", sPDFPath & sPDFName, "", "", 1
End Sub