Fusionner cellule

Bonjour,


Je souhaiterai fusionner une cellule sélectionnée avec celles d'à côté sur une même ligne dans mon programme ci-dessous.
Je parcours les lignes d'une feuille 1, et si toutes les conditions sont bonnes je copie le contenu de la cellule sélectionnée dans une autre cellule Ak de la feuille2. C'est ensuite que je souhaite fusionner la cellule Ak avec Bk,Ck,Dk,Ek,Fk en gardant le contenu copié.
Avez vous une idée?
Merci,
Lucie




Code :

Sub copy_device()

Dim Cell As Range
Dim C As Range
Dim plagecouleur As Range
Dim plage As Range
Dim k As Variant
Dim v As Variant

v = 1

   Application.ScreenUpdating = False
   Source.Activate
   Sheets("Sheet1").Select
   k = 23
   Set WsC = Sheets("Sheet2")
   Set plagecouleur = Columns("A").Rows("3:600")
   For Each Cell In plagecouleur

       Cell.Select
   

    If Selection.Interior.ColorIndex = 15 Then
    k = k + 1
    End If
    
    If Selection.Value = "" And Selection.Interior.ColorIndex <> 15 Then
    Selection.Offset(0, -1).Select
    Selection.Copy
    Source.Activate
    Sheets("Sheet2").Select
    Range("A" & k).Select
    Selection.PasteSpecial
    (fusion de la cellule A avec la cellule B,C, D, E, F de la même ligne)
    k = k + 1
    End If
   
              
    Next
  
    ' Source.Activate
    'Sheets("Sheet2").Select

      Application.ScreenUpdating = True
     
     
     Source.Activate
    Sheets("Sheet1").Select
End Sub