find avec valeur négative

Bonjour,

Voici le code que j'utilise présentement pour trouver les valeurs négatives :

Vérification:
Do Until ActiveCell = ""
With Sheets("Matières premières")
Worksheets("Matières premières").Activate
Range("e3").Activate
Do Until ActiveCell = ""
If ActiveCell.Value < 0 Then
Set ref = ActiveCell
ActiveCell.Copy
With Sheets("à acheter")
Worksheets("à acheter").Activate
Range("c65536").End(xlUp).Offset(1, 0).Select 'Quantité
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With

Worksheets("Matières premières").Activate
Cells(1, Selection.Column).Select
ActiveCell.Offset(0, -1).Copy

With Sheets("à acheter")
Worksheets("à acheter").Activate
Range("b65536").End(xlUp).Offset(1, 0).Select 'date
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With

With Sheets("Matières premières")
Worksheets("Matières premières").Activate
ref.Select
Range(Cells(Selection.Row, 1).Address).Copy 'produit
With Sheets("à acheter")
Worksheets("à acheter").Activate
Range("a65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Worksheets("Matières premières").Activate
ref.Select
ActiveCell.Offset(1, 0).Activate
End With
Else
ActiveCell.Offset(1, 0).Activate
End If

Loop
Cells(1, Selection.Column).Select
ActiveCell.Offset(2, 2).Select
End With
Loop


C'est très long.

Est-ce que je peux utiliser la fonction Find pour accélérer le tout ?

Le fichier est joint si besoin.

Merci