Faire apparaitre une forme quand on écrit dans certaines cellules

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E19:E40")) Is Nothing And Target.Count = 1 Then
    Shapes("Rectangle3").Visible = True
    t = Timer + 5
    Do While Timer < t: DoEvents: Loop
    Shapes("Rectangle3").Visible = False
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E19:E40]) Is Nothing Or Target.Count > 1 Then Exit Sub
Dim ac As Range, o As Object
Application.ScreenUpdating = False
Set ac = ActiveCell
Target.Offset(0, 1).Select
Feuil3.Shapes("Rectangle 3").Copy
Me.Paste
Set o = Selection
ac.Select
Application.ScreenUpdating = True
Application.Wait Now + 5 / 86400
o.Delete
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E19:E40]) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
'suite du code