Celulle fusionnée mise en forme

[LaurentG]

Bonjour,

Voilà mon problème. dnas une feuille j'ai des données l'une en dessous de l'autre qui peuvent être identiques. Si c'est le cas je veux les fusionner.

par exemple si en a1 & a2 j'ai deus données identiques je veux que çà fusionne a1 & a2 mais aussi b1 & b2.

voici le code que j'utilise :

Sub Macro1()

Range('a2').Select

For Each c In [a2:a10]
Application.DisplayAlerts = False
address1 = ActiveCell.Address
If c.Value = ActiveCell.Value Then
address2 = c.Address
Range(address1 & ':' & address2).Select
Selection.Merge
[color=#FF0000]Range(address1 & ':' & address2).Offset(0, 1).Select
Selection.Merge[/color]
Range(address1).Select
Else
c.Select
End If
Next c
Application.DisplayAlerts = True
End Sub

En rouge le code ne fonctionne pas. L'effet de fusion ne fonctionne que sur la colonne 'A'.

Quelqu'un a un avis sur la question?

Merci

Laurent

 

[Bebere]

bonsoir Laurentg
si j'ai bien compris ce qui suit répondra à ta demande
& = concaténation

Sub Essai()
Dim Cel As Range
For Each Cel In Sheets('Feuil1').Range('a1:a10')
If Cel = Cel.Offset(1, 0) Then
Cel = Cel & Cel.Offset(1, 0)
Cel.Offset(0, 1) = Cel.Offset(0, 1) & Cel.Offset(1, 1)
End If
Next Cel
End Sub

à bientôt

 

[Charly2]

Bonsoir Laurent et Bebere

Ce que j'ai compris est peut-être un peu différent : à partir de A1, si dans A1 et A2 il y a 2 données identiques, on fusionne A1 et A2 mais également B1 et B2... Ensuite, on passe forcément à A3 si les cellules précédentes sont fusionnées.

Sub Fusionne()
'
Dim Ligne As Long
'
  Ligne = 1
  Do While Ligne <= 10
    Application.DisplayAlerts = False
    If Cells(Ligne + 1, 1) = Cells(Ligne, 1) Then
      Range(Cells(Ligne, 1), Cells(Ligne + 1, 1)).Merge
      Range(Cells(Ligne, 2), Cells(Ligne + 1, 2)).Merge
      Ligne = Ligne + 2
    Else
      Ligne = Ligne + 1
    End If
    Application.DisplayAlerts = True
  Loop
  Range(Cells(1, 1), Cells(Ligne - 1, 2)).VerticalAlignment = xlCenter
End Sub

Amicalement
Charly