Fussionner les cellules

[recovery]

Bonjour les EXCELIENS professionnelles j' ai besoin de nouveau de votre aide
d'ailleurs le fichier et joint .

j'expose le problème via un userform je crée un planning avec une liste de personne qui auront un cours à une heure précise avec un intervenant pour chaque groupe en fonction de leur niveau.

Devant chaque groupe il y a le non de l'intervenant qui prend en charge ce dernier
j'aimerais via une macro que la cellules qui contient le nom de l'intervenant soit fusionnée
avec toutes les autres situés en dessous. Problème pour moi en tout cas chaque groupe est séparé par une ligne blanche.
J'insère le dossier pour plus de compréhension et vous remercie de consacrer un peu de votre temps avec des novices en VBA.

 

[JNP]

Re : Fussionner les cellules

Bonjour Recovery ,
A condition de supprimer ton "Avant macro" qui est en colonne B

Sub test()
Dim I As Integer, J As Integer, Limite As Integer, PremLig As Integer
Limite = Evaluate("COUNTA(B:B)")
J = 1
While I < Limite
If Range("B" & J) <> "" And Range("C" & J) <> "" Then PremLig = J
If PremLig <> 0 And Range("C" & J) = "" Then
With Range("B" & PremLig & ":B" & J - 1)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
PremLig = 0
I = I + 1
End If
J = J + 1
Wend
End Sub

Bon dimanche

 

[recovery]

Re : Fussionner les cellules

Un Grand Merci "JNP"
Cela fonctionne parfaitement pour ma part cela faisait plus d'une semaine que je me prenais la tête.

Pourrais tu me décortiquer la syntaxe utilisée de manière à ce que je travaille dessus.

Encore Merci

 

[JNP]

Re : Fussionner les cellules

Re ,
Voilà

Sub test()
Dim I As Integer, J As Integer, Limite As Integer, PremLig As Integer
Limite = Evaluate("COUNTA(B:B)")
'Evaluate("COUNTA(B:B)") est équivalent à la formule de feuille NBVAL(B:B),
'donc te fournit le nombre de noms à traiter
J = 1
While I < Limite
' Tant que I n'a pas atteint le nombre de noms
If Range("B" & J) <> "" And Range("C" & J) <> "" Then PremLig = J
'Si je trouve un nom et un groupe, je mémorise la ligne
If PremLig <> 0 And Range("C" & J) = "" Then
' si une ligne est mémorisée et que le groupe est vide
With Range("B" & PremLig & ":B" & J - 1)
'Avec le groupe de cellule de PremLig au dernier groupe non vide
.Merge
'Fusion
.VerticalAlignment = xlCenter
'Centre en hauteur
.HorizontalAlignment = xlCenter
'Centre en largeur
End With
PremLig = 0
' Réinitialise PremLig
I = I + 1
'Comptabilise un nom de plus
End If
J = J + 1
'Descends à la ligne suivante
Wend
'Boucle
End Sub

Bon dimanche

 

[recovery]

Re : Fussionner les cellules

Merci beaucoup JNP

Bon dimanche à toi

cordialement.