Fusion de colonne

Bonjour,

Actuellement sur un projet excel pour ma société je recherche un code VBA qui me permettrait de faire de la fusion de cellule .

Je m'explique ( Onglet planning_annuel) mon utilisateur lambda remplit la cellule B2 avec la date de début du planning ce qui va mettre à jour les lignes 3, 4 et 5 avec le mois, le numéro de semaine et la date.

Je souhaiterais que mon utilisateur appuie sur Bouton1 ( Changera de place ) et chaque cellule identique dans les lignes 3;4 et 5 si la valeur est identique on fusionne . Ce qui permettra de devenir comme l'onglet "resultat"

J'ai essayé divers codes et le seul qui a permis de faire un début de fusion fut celui-ci :

Sub Bouton1_Cliquer()
Dim Cel As Range

MsgBox Month(CDate(Sheets("Planning_Annuel").Range("F2")))
MsgBox Month(CDate(Sheets("Planning_Annuel").Range("G2")))

'**** Code Ok *****
If Month(CDate(Sheets("Planning_Annuel").Cells(3, 6))) = Month(CDate(Sheets("Planning_Annuel").Cells(3, 7))) Then
 Range(Sheets("Planning_Annuel").Cells(3, 6), Sheets("Planning_Annuel").Cells(2, 7)).Merge
 MsgBox Sheets("Planning_Annuel").Cells(3, 6).Value
End If

'***** Code Not OK *****
If Month(CDate(Sheets("Planning_Annuel").Cells(3, 7))) = Month(CDate(Sheets("Planning_Annuel").Cells(3, 8))) Then
 Range(Sheets("Planning_Annuel").Cells(3, 7), Sheets("Planning_Annuel").Cells(3, 8)).Merge
 Sheets("Planning_Annuel").Cells(3, 8).Select
End If

End Sub

Mais celui-ci ne fonctionne pas comme je souhaite car la valeur de la cellule (3,7) ne remonte pas malheureusement elle est prise en compte comme étant la cellule (3,6)

Je vous remercie pour les réponses que vous pourrez m'apporter.

Cordialement,

Antho49000

Bonjour,

sans même ouvrir ton fichier, je pense qu'il est très déconseillé de fusionner des cellules...

pour le reste, je laisse d'autres s'y atteler

P.

Malheureusement pour des raisons de lisibilité et de fonctionnalité pour mes différents utilisateurs cela est nécessaire . Même au niveau de l'impression cela serait plus lisible .

Bonjour,

Après pas mal de recherche j'ai trouver une façon de faire ce que je désire voici le code :

Sub Bouton1_Cliquer()
Dim Cel As Range
Dim x As Integer

Application.DisplayAlerts = False

x = 371

While x >= 6

If Sheets("Planning_Annuel").Cells(5, x).Value = Sheets("Planning_Annuel").Cells(5, x - 1).Value Then
 Range(Sheets("Planning_Annuel").Cells(5, x), Sheets("Planning_Annuel").Cells(5, x - 1)).Merge
    Else

End If

x = x - 1
Wend

x = 371

While x >= 6

If Month(CDate(Sheets("Planning_Annuel").Cells(4, x))) = Month(CDate(Sheets("Planning_Annuel").Cells(4, x - 1))) Then
 Range(Sheets("Planning_Annuel").Cells(4, x), Sheets("Planning_Annuel").Cells(4, x - 1)).Merge
    Else

End If

x = x - 1
Wend
Application.DisplayAlerts = True

End Sub

Et je vous fournis le fichier pour les personnes qui peuvent en avoir besoin