Ligne d'origine receptionnée à passer outre

Bonjour à tous

Dans la continuité de mon fichier de suivi des OF de ma boite, avant de réinitialiser le document, je procède à une copie des commentaires de la semaine précédente sur la feuille Calcul.

Je procède à la mise à jour de la feuille OF en y injectant les OF non soldés ainsi que les nouveaux.

Jusqu'ici, pas de problèmes.

Ou ça se complique, c'est lorsque, de la feuille Calcul, je veux renvoyer les commentaires de la semaine précédente sur la feuille OF qui vient d'être mise à jour et sur laquelle, certaines lignes ont disparues car elles sont fabriquées.

Cela arrive sur d'anciennes lignes ou il y avait des commentaires, et lorsque je procède à la recherche, ça plante.

Auriez-vous une solution à mon problème ?

Voici le code que j'utilise:

Option Explicit

Sub RecherchCommentaires()

Dim Lign As Variant

Dim OF As Variant

Sheets("Calcul").Activate

Lign = 1

While cells(Lign, 1).Value <> ""

OF = cells(Lign, 1).Value

cells.Find(What:=OF, After:=activecell, LookIn:=xlFormulas, LookAt _

:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

True, SearchFormat:=False).Activate

activecell.Offset(0, 9).Range("A1").Select

Selection.Copy

Sheets("OF").Activate

Range("C2").Select

cells.Find(What:=OF, After:=activecell, LookIn:=xlFormulas, LookAt _

:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

True, SearchFormat:=False).Activate

activecell.Offset(0, 20).Range("A1").Select

ActiveSheet.Paste

Application.CutCopyMode = False

Sheets("Calcul").Activate

Lign = Lign + 1

Wend

End Sub

Merci pour votre aide.

@+

Robert

Bonjour

Le problème c'est quand tu recherche tu ne testes pas si tu as trouvé

Une autre manière de faire

Option Explicit

Sub RecherchCommentaires()
Dim Cel As Range
Dim J As Long

  With Sheets("Calcul")
    For J = 1 To Sheets("Calcul").Range("A" & Rows.Count).End(xlUp).Row
      Set Cel = Sheets("OF").Columns("C").Find(what:=.Range("A" & J), LookIn:=xlValues, lookat:=xlWhole)
      If Not Cel Is Nothing Then
        Cel.Offset(0, 20) = .Range("J" & J)
      End If
    Next J
  End With
End Sub

Bonjour à tous

La preuve que je suis un petit en VBA

C'est du travail de pro que voici, ça marche à la perfection.

Merci beaucoup Banzai64

@+

Robert