Celulle fusionnée mise en forme

LaurentG · 5 Décembre 2005

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 :

Code:

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 · 5 Décembre 2005

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 · 6 Décembre 2005

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

Celulle fusionnée mise en forme

LaurentG

XLDnaute Occasionnel

Bebere

XLDnaute Barbatruc

Charly2

Nous a quittés en 2006

Discussions similaires