VBAPlus de souplesse dans ma macro évènementielle

Cells(Target.Row, 6).Value = Application.WorksheetFunction.Round _
    (IIf(Cells(Target.Row, 4).Value * Cells(Target.Row, 5).Value = 0, "", Cells(Target.Row, 4).Value * Cells(Target.Row, 5).Value), 2)

If Cells(Target.Row, 4).Value <> "" or Cells(Target.Row, 4).Value <>0 then
Cells(Target.Row, 6).Value = Application.WorksheetFunction.Round _
 (IIf(Cells(Target.Row, 4).Value * Cells(Target.Row, 5).Value = 0, "", Cells(Target.Row, 4).Value * Cells(Target.Row, 5).Value), 2)
End If

Cells(Target.Row, 6).Value = Application.WorksheetFunction.Round _
    (IIf(Cells(Target.Row, 4).Value * Cells(Target.Row, 5).Value = 0, 0, Cells(Target.Row, 4).Value * Cells(Target.Row, 5).Value), 2)

Target = VBA.UCase(Target)                            ' Met en majuscule
  With Sheets("Fournisseurs")                         ' Prend en compte l'onglet "Fournisseurs"
   Set pl = .Range("A3:A" & .Range("A65536").End(xlUp).Row) 'Définit la plage  recherche
  End With                                   'Fin de la prise en compte de l'onglet "Fournisseurs"
   Set r = pl.Find(Target.Value, , xlValues, xlWhole)               ' Définit la recherche
        If r Is Nothing Then                                        ' Si pas trouvé on sort
          MsgBox "Code non trouvé !"                                ' Message
          Application.EnableEvents = True
          Exit Sub

If Target.Row > Cel.Row - 2 Then
          Target.Copy Cells(51, "A")                                  ' Recopie de la référence
          Target.ClearContents                                        ' Efface l'ancienne référence
          Set Target = Cells(51, "A")                                 ' Actualise Target
        End If

Dim pl1 As Range     ' déclare la variable pl (PLage)
Dim r1 As Range      ' déclare la variable r (Recherche)
Dim h As Range, h1 As Range, h2 As Range
With Worksheets("Devis")
     Set r1 = .Range("A20:A" & .Range("A108").End(xlUp).Row)
    End With
  
    With Sheets("Fournisseurs")
     Set pl1 = .Range("A3:E" & .Range("A65536").End(xlUp).Row)
    End With
    On Error Resume Next
    Do While r1.Row > 19
        If r1 <> "" Then
            h = WorksheetFunction.VLookup(r1, pl1, 2, True)
            h1 = WorksheetFunction.VLookup(r1, pl1, 3, True)
            h2 = WorksheetFunction.VLookup(r1, pl1, 5, True)
            
            If Err.Number = 0 Then
                r1(1, 2) = h
                r1(1, 3) = h1
                r1(1, 5) = h2
            End If
            Err.Clear
        End If
    Set r1 = r1(0, 1) ' Recule d'une ligne
    Loop