Option Explicit
Sub Report()
Dim Cel As Range, PlageS As Range, PlageC As Range
Set PlageS = Feuil1.Range("B3:P5")
Set PlageC = Feuil1.Range("B7:P9")
PlageC.Interior.ColorIndex = 0
For Each Cel In PlageS
If Cel.Interior.ColorIndex = 6 Then Cel.Copy Cel.Offset(4, 0)
Next Cel
End Sub