Affecter une image sous conditions

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cel As Range, ecart
Application.ScreenUpdating = False
Me.DrawingObjects.Delete
For Each cel In [B9,D9,F9,I9]
  If cel <> "" And cel(3) <> "" Then
    ecart = IIf(cel.Column = 9, 2000, 1000)
    If cel(3) >= cel Then
      CopieImage 1, cel
    ElseIf cel - cel(3) <= ecart Then
      CopieImage 2, cel
    Else
      CopieImage 3, cel
    End If
  End If
Next
ActiveCell.Activate
[A1].Copy [A1] 'vide le presse-papier
End Sub

Sub CopieImage(n As Byte, cel As Range)
Sheets("Images").DrawingObjects("Image " & n).Copy
Me.Paste
With cel(6)
  Selection.Top = .Top + (.Height - Selection.Height) / 2
  Selection.Left = .Left + (.Resize(, 2).Width - Selection.Width) / 2
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cel As Range, ecart, n As Byte
Application.ScreenUpdating = False
Me.DrawingObjects.Delete
For Each cel In [B9,D9,F9,I9]
  If cel <> "" And cel(3) <> "" Then
    ecart = IIf(cel.Column = 9, 2000, 1000)
    n = IIf(cel(3) >= cel, 1, IIf(cel - cel(3) <= ecart, 2, 3))
    Sheets("Images").DrawingObjects("Image " & n).Copy
    Me.Paste
    With cel(6)
      Selection.Top = .Top + (.Height - Selection.Height) / 2
      Selection.Left = .Left + (.Resize(, 2).Width - Selection.Width) / 2
    End With
  End If
Next
ActiveCell.Activate
[A1].Copy [A1] 'vide le presse-papier
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, ecart, n As Byte
Application.ScreenUpdating = False
Me.DrawingObjects.Delete
For Each cel In [B9,D9,F9,I9]
  If cel <> "" And cel(3) <> "" Then
    ecart = IIf(cel.Column = 9, 2000, 1000)
    n = IIf(cel(3) >= cel, 1, IIf(cel - cel(3) <= ecart, 2, 3))
    Sheets("Images").DrawingObjects("Image " & n).Copy
    Me.Paste
    With cel(6)
      Selection.Top = .Top + (.Height - Selection.Height) / 2
      Selection.Left = .Left + (.Resize(, 2).Width - Selection.Width) / 2
    End With
  End If
Next
ActiveCell.Activate
Application.EnableEvents = False
[A1].Copy [A1] 'vide le presse-papier
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub