Copie cellules sur base de donnée

Bonjour le forum

J'ai trouvé sur le forum un post généré par InKoNiTo et répondu par Banzai64.

https://forum.excel-pratique.com/excel/copier-range-d-une-feuille-a-l-autre-si-cellule-identiques-t47990.html

J'ai légèrement retouché le code initial pour l'adapter à mon besoin.

Le fichier joint montre mon besoin.

Voici le code

Sub Recopie()
Dim Cells As Range
Dim J As Long

  With Sheets("Feuil2")

     For J = 1 To Range("A" & Rows.Count).End(xlUp).Row
      Set Cells = .Columns("E").Find(what:=Range("A" & J), LookIn:=xlValues, lookat:=xlWhole)
      If Not Cells Is Nothing Then
        Range("B" & J).Copy Cells.Offset(0, -1)
      End If
    Next J
  End With
End Sub

Le problème avec ce code est qu'il recopie effectivement les cellules correspondantes à ma base de donnée

mais il les recopie une seule fois par valeur (voir fichier joint).

Dans mon exemple je travaille sur une seule feuille mais à terme ce sera deux feuilles séparées (voire deux classeurs différents!!!).

Merci de votre aide

Bonjour,

Essaie comme cela

Sub Recopie()
Dim Cel As Range
Dim J As Long
Dim firstAddress As String
  With Sheets("Feuil1")
    For J = 1 To Range("A" & Rows.Count).End(xlUp).Row
      Set Cel = .Columns("E").Find(what:=Range("A" & J), LookIn:=xlValues, lookat:=xlWhole)
      If Not Cel Is Nothing Then
            firstAddress = Cel.Address
            Do
                Range("B" & J).Copy Cel.Offset(0, -1)
                Set Cel = .Columns("E").FindNext(Cel)
            Loop While Not Cel Is Nothing And Cel.Address <> firstAddress
      End If
    Next J
  End With
End Sub

A+

Bonjour le forum

Frangy je viens d'essayer ta version et ça marche impec

Je te remercie pour ton aide efficace.

Bonne journée