Action de recherche format de cellule

Bonjour à tous,
Comment modifier et placer ce code dans :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

pour qu'il agisse seulement sur la cellule dont la valeur change


Dim Source As Range, Cible As Range, Cel As Range, CelSource As Range

Set Source = Sheets("PARC").Columns(3)
Set Cible = Sheets("ROSE").Range("C6:C26,H6:H37,H32:H41,M6:M41,R6:R39")

On Error Resume Next
Sheets("PARC").ShowAllData

For Each Cel In Cible
Set CelSource = Source.Find(Cel, , xlValues, xlWhole)
Flag = False
If Not CelSource Is Nothing Then
CelSource.Copy: Cel.PasteSpecial Paste:=xlPasteAllExceptBorders
Else: Sheets("ROSE").Range("Z1").Copy: Cel.PasteSpecial Paste:=xlPasteAllExceptBorders
End If
Flag = True
Next Cel
With Application
.CutCopyMode = False

End With
Range("AA6:AA26").Select
Selection.Copy

Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("AG6:AG30").Select
Application.CutCopyMode = False
Selection.Copy


Range("I6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("AM6:AM37").Select
Application.CutCopyMode = False
Selection.Copy

Range("N6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("AS6:AS39").Select
Application.CutCopyMode = False
Selection.Copy

Range("S6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("D6").Select
Application.CutCopyMode = False
Selection.Cut
ActiveSheet.Paste

ActiveWindow.ScrollColumn = 1
Range("C6").Select
Sheets("ROSE").Protect
Application.ScreenUpdating = True
End Sub

j'espère avoir été claire, j'essaie de faire simple