fusionner des cellules avec toutes leurs données

Bonjour,
à première vue la fusion ne conserve que le contenu de la cellule
haut_gauche

avec une macro comme celle-ci, on peut s'en sortir

Sub fusion()
'
' fusion Macro
' Macro enregistrée le 15/07/2010 par Michel
'
' Touche de raccourci du clavier: Ctrl+w
'
For Each cell In Selection
texte = texte & cell.Value & Chr(32)
Next cell
With Selection
.ClearContents
.MergeCells = True
.Value = texte
End With
End Sub

J'ai mis Chr(32) pour avoir un espace entre le contenu de chaque cellule. A
toi de voir si tu préfères une autre disposition : Chr(10) par exemple pour
un retour à la ligne.
Au début de l'enregistrement de la macro, j'ai précisé que je voulais
l'appeler en faisant Ctrl+w

Utilisation :
selectionner les cellules concernées et faire Ctrl w

Cordialement
Michel dit "Sam"


"Vincent" <raciv2@orange.fr> a écrit dans le message de news:
4c3ee96d$0$2966$ba4acef3@reader.news.orange.fr...

Bonjour, question sans doute posée des millions de fois (et dont je
redoute la réponse) : y a t-il moyen, quand on fusionne des cellules, de
conserver les données de chacunes d'elles dans la grande cellule résultant
de la fusion?

On 15 juil, 13:00, "Vincent" <rac...@orange.fr> wrote:

Bonjour, question sans doute posée des millions de fois (et dont je red oute
la réponse) : y a t-il moyen, quand on fusionne des cellules, de conser ver
les données de chacunes d'elles dans la grande cellule résultant de l a
fusion?

En magasin j'ai presque la même chose que celle de Sam. La différence
c'est que la sélection de départ peut être multiple.

Sub FusionSelection()

' Récupère dans la 1ère cellule d'une sélection le contenu de toute s
les cellules de la sélection
' Si la sélection comporte plusieurs zones chaque zone est traitée
indépendamment.
Dim cf As String
Dim n As Long, i As Long
Dim c As Range, sousC As Range
n = Selection.Areas.Count
For i = 1 To n
cf = ""
Set sousC = Selection.Areas(i)
For Each c In sousC
cf = cf & " " & c
Next c
sousC.ClearContents
sousC.Resize(1, 1) = Trim(cf)
Next i
Selection.MergeCells = True
End Sub

Cordialement,
Trirème