Exécution de mon code très longue, Qui peut m'aider ?

Bonjour,

Afin de mettre mes liens hypertextes à jour d'une feuille à une autre,
j'utilise le code suivant pour copier des cellules:
--------------------------------------------------------------------------
Sub Copie_Refs()
Dim Plage As Range
Dim VAL As Range
Dim CELL As Range
Dim CherCh As Range
With Feuil3
Set Plage = .Range("DISPO") 'plage => 'Liste des docs
dispo.'!$A$3:$G$130
End With
For Each CELL In Feuil2.Range("REFS") 'plage => Documentations!$B$8:$B$530
Feuil2.Activate
CELL.Activate
For Each VAL In Plage
Feuil3.Activate
Set CherCh = VAL.Find(What:=CELL, lookat:=xlWhole)
If Not CherCh Is Nothing And (VAL <> "") Then
CherCh.Copy
Feuil2.Activate
CELL.Activate
ActiveSheet.Paste
End If
Next VAL
Set CherCh = Nothing
Next CELL
End Sub
--------------------------------------------------------------------------
En fait, je teste cellule par cellule une plage REFS (1 colonne) et je vais
vérifier dans l'autre feuille dans la plage DISPO (7 colonnes) et si ma
valeur existe elle est recopiée dans la première feuille.
Je trouve que ma macro met énormément de temps à s'exécuter car je pense
l'avoir programmée comme un "Gouniafié".

Donc, si l'un des lecteurs de ce post peut me simplifier ce code, je lui en
serait très reconnaissant.

Par avance, merci.

Tatane.