[VBA] Etendre une macro sur colonne

Bonjour,

D'abord j'ai un niveau débutant en programmation donc en VBA aussi.

Mais je suis sur que la difficulté que je rencontre est très simple pour quelqu'un d'initié.

Voila je fais une macro qui va concatener et me mettre en forme comme je voudrais dans la cellule concatenée.

Sub ConcatGras()

Cells(2, 1).Value = Cells(2, 2).Value & Cells(2, 3).Value & Cells(2, 4).Value & Cells(2, 5).Value

Cells(2, 1).Characters(Start:=1, Length:=Len(Cells(2, 2).Value)).Font.ColorIndex = xautomatic

Cells(2, 1).Characters(Start:=Len(Cells(2, 2).Value) + 1, Length:=Len(Cells(2, 3).Value)).Font.Bold = True

Cells(2, 1).Characters(Start:=Len(Cells(2, 2).Value) + Len(Cells(2, 3).Value) + 1, Length:=Len(Cells(2, 4).Value)).Font.Bold = True

Cells(2, 1).Characters(Start:=Len(Cells(2, 2).Value) + Len(Cells(2, 3).Value) + Len(Cells(2, 4).Value) + 1, Length:=Len(Cells(2, 5).Value)).Font.ColorIndex = xautomatic

End Sub

Donc ca me concatène B2 C2 D2 E2 et ca me met en gras ce qu'il y avait dans C2 et D2.

Jusque la pas de soucis ca fonctionne, mais je voudrais que ca le fasse jusqu'en bas de ma page excel, du moins jusqu'a ce qu'il y ait quelque chose dans mes cellules et pour moi ca se complique.

Alors je crois qu'on peut le faire de cette facon :

Sub ConcatGras()

Dim Cel_C As Range

Range("A2:A" & Range("A65536").End(xlUp).Row).Select

For Each Cel_C In Selection

Cells(2, 1).Value = Cells(2, 2).Value & Cells(2, 3).Value & Cells(2, 4).Value & Cells(2, 5).Value

Cells(2, 1).Characters(Start:=1, Length:=Len(Cells(2, 2).Value)).Font.ColorIndex = xautomatic

Cells(2, 1).Characters(Start:=Len(Cells(2, 2).Value) + 1, Length:=Len(Cells(2, 3).Value)).Font.Bold = True

Cells(2, 1).Characters(Start:=Len(Cells(2, 2).Value) + Len(Cells(2, 3).Value) + 1, Length:=Len(Cells(2, 4).Value)).Font.Bold = True

Cells(2, 1).Characters(Start:=Len(Cells(2, 2).Value) + Len(Cells(2, 3).Value) + Len(Cells(2, 4).Value) + 1, Length:=Len(Cells(2, 5).Value)).Font.ColorIndex = xautomatic

Next Cel_C

End Sub

Mais voila je sais pas quoi mettre dans mes coordonnées de cellules pour la faire fonctionner.

Si quelqu'un pouvait me donner un coup de main, merci.

Bonjour et bienvenu sur le forum,

Il y a bien entendu plusieurs solutions possibles. Essaye le code suivant :

Sub ConcatGras()
    [A2].Select
    While ActiveCell.Offset(0, 1).Value <> "" Or ActiveCell.Offset(0, 2).Value <> "" Or ActiveCell.Offset(0, 3).Value <> "" Or ActiveCell.Offset(0, 4).Value <> ""
        ActiveCell.Value = ActiveCell.Offset(0, 1).Value & ActiveCell.Offset(0, 2).Value & ActiveCell.Offset(0, 3).Value & ActiveCell.Offset(0, 4).Value
        ActiveCell.Characters(Start:=Len(ActiveCell.Offset(0, 1).Value) + 1, Length:=(Len(ActiveCell.Offset(0, 2).Value)) + Len(ActiveCell.Offset(0, 3).Value)).Font.Bold = True
        ActiveCell.Offset(1, 0).Activate
    Wend
End Sub

Cdlt,

Re bonjour,

J'ai encore du mal avec cette forme la pour comprendre comment ca marche.

Mais ca marche très bien alors je vais voir comment l'assimiler et merci Raja.

Re,

1ère ligne sélectionne la cellule A2 et elle devient la cellule active.

La 2ème ligne du code est un boucle. Tant que les 4 cellules à droite de la cellule active ne sont pas en même temps vides, il continue.

La 3è ligne à l'intérieur de ce boucle concatène le contenu des 4 cellules à droite de la cellule active.

La 4ème ligne met le format Gras pour la longueur du texte calculée par la formule.

La 5ème change la cellule active en restant sur la colonne A.

Le boucle s'arrête quand il y a rien à concaténer.

Cdlt,

Super merci pour les explications.

Juste une chose quand je mets des espaces entre chaque cellule concaténée le gras ne s'applique plus correctement, je pensais que ca prenait tout le contenu de la cellule.

Y a un moyen de contourner ca ?

Ca y est j'ai trouvé à la place de mettre :

ActiveCell.Characters(Start:=Len(ActiveCell.Offset(0, 1).Value) + 1, Length:=(Len(ActiveCell.Offset(0, 2).Value)) + Len(ActiveCell.Offset(0, 3).Value)).Font.Bold

Je mets juste :

ActiveCell.Characters(Start:=11, Length:=Len(ActiveCell) - 20).Font.Bold

Alors c'est pas très modulable mais ca marche pour ma feuille.

C'est dommage j'aurais aimé le faire autrement.