Microsoft 365 Fusionner des cellules identiques horizontalement

[Louism]

Bonjour,

Je viens de créer un planning annuel partiellement automatisé sur 13 mois pour suivre les absences des employés.

Le but de ce fichier est d'être un modèle pour créer rapidement le planning pour les années suivantes. Mon planning se met à jours en modifiant ma date d'entrée dans le premier onglet, mais j'aimerais trouver un moyen de fusionner les cellules des N° de semaine en ligne 12. Ci-joint mon fichier pour visualiser ma demande. Je suis à l'aise avec les formules, mais je n'ai aucune expérience en macro et VBA.

J'ai actuellement deux modèles (1 pour les années de 365 jours et un modèle pour les années de 366 jours).

En vous remerciant par avance pour votre aide !

 

[pierrejean]

Bonjour Louism

Voici la macro a lancer pour obtenir la fusion

Sub Macro1()
Dim debut As Range
Set debut = Cells(12, 3)
For n = 4 To Cells(12, Columns.Count).End(xlToLeft).Column
If Cells(12, n) <> debut.Value Then
Application.DisplayAlerts = False
Range(debut, Cells(12, n - 1)).MergeCells = True
Application.DisplayAlerts = True
Set debut = Cells(12, n)
End If
Next
End Sub

 

[Louism]

Bonjour PierreJean,

Je vous remercie pour cette macro, c'est exactement ce qu'il me fallait !

Par contre, j'ai essayé de lancer la macro en mettant en année de réf 2022 ou 2023 et je vois que la fusion ne se fait pas pour les dernières colonnes. Que dois-je modifier dans la macro ?

En vous remerciant par avance !

 

[pierrejean]

Re

A tester:
Sub Macro1()
Dim debut As Range
Set debut = Cells(12, 3)
For n = 4 To Cells(12, Columns.Count).End(xlToLeft).Column + 1
If Cells(12, n).Value <> debut.Value Then
Application.DisplayAlerts = False
Range(debut, Cells(12, n - 1)).MergeCells = True
Application.DisplayAlerts = True
Set debut = Cells(12, n)
End If
Next
End Sub

 

[Louism]

C'est parfait, ça marche ! Merci beaucoup pour votre aide !

Passez une bonne journée !