Copie des éléments avec des buttons

Mon problème est expliqué avec le fichier

Bonjour

J'ai trouvé un macro ,mais le problème c'est que ce code ne traite pas le cas des case fusionnée il est parfait pour les cas simple mais dans ma situation j’obtiens un erreur dans cette partie "" .Range("F" & a).Resize(1, 2).Copy Range("B" & Cel1.Row)"""

Private Sub CommandButton1_Click()

Dim a As Long

Dim Cel1 As Range

Dim Depart1 As String

Application.ScreenUpdating = False

With Sheets("Feuil2")

For a = 2 To .Range("E" & Rows.Count).End(xlUp).Row

Set Cel1 = Columns("A").Find(what:=.Range("E" & a), LookIn:=xlValues, lookat:=xlWhole)

If Not Cel1 Is Nothing Then

Depart1 = Cel1.Address

Do

.Range("F" & a).Resize(1, 2).Copy Range("B" & Cel1.Row)

Exit Do

Set Cel1 = Columns("B").FindNext(Cel1)

Loop While Depart1 <> Cel1.Address

End If

Next a

End with

End sub

Bonjour

Sans exemple de résultat j'ai interprété comme j'ai pu

A vérifier

j'ai effectué quelques modification et il fonctionne parfaitement merci bcppppp Banzai

you are the best man