J'ai retouché comme suit :
Option Explicit
Private moShS As Worksheet
Private miEcr As Integer
Public Sub Synthese()
Set moShS = Worksheets("OIL - CR DR (DR R)")
miEcr = 8
Copier "CL DR (DR)", 9, 59
Copier "CL DRE (T)", 78, 111
Copier "CL FTA (FR)", 78, 111 'ajout onglet N°3
Copier "CL BDI (BDI)", 64, 83 'ajout onglet N°4
Set moShS = Nothing
End Sub
Private Sub Copier(psOnglet As String, piLigDeb As Integer, piLigFin As Integer)
Const L_COUL_BLEU As Long = 12611584
Const S_NOK As String = "NOK"
Dim oSh As Worksheet
Dim iLig As Integer
Set oSh = Worksheets(psOnglet)
Application.ScreenUpdating = False
For iLig = piLigDeb To piLigFin
If oSh.Range("J" & iLig) = S_NOK Then
'Question N°
moShS.Range("A" & miEcr).Value = oSh.Range("A" & iLig).Value
'Type de DR
moShS.Range("B" & miEcr).Value = oSh.Range("M4").Value
'Date DR
moShS.Range("C" & miEcr).Value = oSh.Range("F3").Value
'Projet
moShS.Range("D" & miEcr).Value = oSh.Range("F2").Value
'Titre
moShS.Range("E" & miEcr).Value = oSh.Range("M2").Value 'complété avec la bonne cellule
'EDU
moShS.Range("F" & miEcr).Value = oSh.Range("F4").Value 'complété avec la bonne cellule
'Type
moShS.Range("G" & miEcr).Value = oSh.Range("M4").Value
'Évaluation des risques
moShS.Range("I" & miEcr).Value = oSh.Range("L" & iLig).Value
'Plan d'Action
moShS.Range("L" & miEcr).Value = oSh.Range("O" & iLig).Value
'Pilot Action
moShS.Range("P" & miEcr).Value = oSh.Range("S" & iLig).Value
'Criticity L - M - H
moShS.Range("Q" & miEcr).Value = oSh.Range("R" & iLig).Value
'pour Quand
moShS.Range("R" & miEcr).Value = oSh.Range("T" & iLig).Value
'Pt Fermé le
moShS.Range("S" & miEcr).Value = oSh.Range("U" & iLig).Value 'supprimé la cellule ??? pour Open/Closed
'ligne suivante
miEcr = miEcr + 1
'si ligne de titre, ajoute encore une ligne
If moShS.Range("A" & miEcr).Interior.Color = L_COUL_BLEU Then
miEcr = miEcr + 1
End If
End If
Next iLig
Application.ScreenUpdating = True
Set oSh = Nothing
End Sub