Discussion :

[eddyG]

Bonjour,


Existe-t-il une commande VBA pour fusionner automatiquement toutes les cellules d'une même ligne ayant le même contenu?

Si oui, pouvez vous me la passer, SVP?

[Lexot2]

Bonsoir

Avec un exemple, ce sera plus explicite! Je n'ai pas très bien compris comment fusionner. Ce sera une fusion avec 2 cellules ou davantage? Supposons qu'il s'agit d'une fusion avec 2 cellules, et qu'on trouve un contenu identique, la 2ème cellule fusionnée sera celle de droite ou de gauche?

Cordialement

[eddyG]

Merci de ta réponse,


Pour être plus explicite, c'est une ligne "en tête" de colonne qui peut être parfois égale.


Cela veut dire que sur la même ligne, je peux parfois avoir 2 ou plus contenu identique et je voudrais qu'automatiquement, la valeur de gauche soit gardé.
Tout cela sur l'ensemble de ma ligne.

Merci d'avance

Eddy

[RLX]

Salut eddyG,

Il faut que tu fasse une fonction qui repère toutes les cellules identiques et avec Range tu as une methode .MergeCells (si tu mets à "True" fusionne les celulles) qui te permet de fusionner tes cellules

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set Maplage = Range("A1:C3")
Maplage.MergeCells = True

[eddyG]

Ca ne fonctionne pas, car je voudrais que mon code regarde la cellule A1 et la B1 et si elles sont égale, elles se fusionnent, ensuite, il regarderais dans les cellules suivantes et si C1, D1 et E1 sont égales, elles se fuisonnent et ainsi de suite!

[AlainTech]

Maintenant qu'on t'a dit comment faire la fusion, et comme tu as bien décrit les opérations à faire, tu n'as plus qu'à écrire le code...

[SfJ5Rpw8]

tiens un peu de code à étudier...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub Macro1()
Dim r As Range
Dim c As Range
Application.DisplayAlerts = False
 
With ThisWorkbook.Sheets(1)
 Set r = .Range(.[A1], .[IV1].End(xlToLeft))
 For Each c In r
  If c = c.Offset(0, 1) Then .Range(c, c.Offset(0, 1)).Merge
 Next
End With
 Application.DisplayAlerts = True
End Sub