Dé fusionner les cellules et copier les valeurs.

jose.carreira

XLDnaute Junior
Ne maîtrisant pas très bien les macros, je solidité votre aide.

En effet, dans un onglet Excel j'ai un tableau qui va de la colonne "A" à la colonne "BA" sur 1200 lignes environ.
Sur chaque colonne j'ai des cellules vide et d'autres avec des données.
Certaines cellules sont fusionnées.

La question, comment via une macro puis-je.

1 - Dé fusionner les cellules
2 - Recopier la valeur initiale dans les cellules qui sont devenues vide à la suite de la dé-fusion
3 - Ne pas s'occuper des cellules vides ni de celles qui ne sont pas fusionner.

Je présume qu'il faudrait déjà compter le nombre de lignes utiliser puis de faire une boucle sur toutes les cellules fusionner pour faire le traitement sur les toutes les colonnes.
Le gros problème c’est qu’aucune colonne n’est obligatoirement remplie jusqu’en bas.
Pour étailler mes dires je vous ajoute un petit tableau comme exemple.

Pouvez-vous m'aider s'il vous plaît.

Merci d'avance.
 

Pièces jointes

  • Exemple.xlsx
    12.6 KB · Affichages: 53
  • Exemple.xlsx
    12.6 KB · Affichages: 52
  • Exemple.xlsx
    12.6 KB · Affichages: 62

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Dé fusionner les cellules et copier les valeurs.

Bonsoir jose.carreira,

Un essai dans le fichier joint avec le code dans module1 associé au bouton Hop!
(pas de traitement des cellules vides fusionnées ou non)
VB:
Sub DeFusionner()
Dim plage As Range, xarea As Range, xcell As Range, yarea As Range

On Error Resume Next
Set plage = Application.InputBox("Sélectionner la plage à traiter", Type:=8)
If plage Is Nothing Then
  MsgBox "Plage incorrecte -> FIN."
  Exit Sub
Else
  Application.ScreenUpdating = False
  For Each xarea In plage.Areas
    For Each xcell In xarea
      If Len(xcell) > 0 Then
        If xcell.MergeCells Then
          Set yarea = xcell.MergeArea
          xcell.UnMerge
          xcell(1, 1).Copy yarea
        End If
      End If
    Next xcell
  Next xarea
End If
End Sub
 

Pièces jointes

  • jose.carreira-(Dé)Fusionner-v1.xlsm
    20.9 KB · Affichages: 52
Dernière édition:

Yaloo

XLDnaute Barbatruc
Re : Dé fusionner les cellules et copier les valeurs.

Re,

Un essai avec cette macro.

VB:
Sub CelFusion()
Dim Cel As Range, AdCel$
For Each Cel In [A5].CurrentRegion
  If Cel.MergeArea.Cells.Count <> 1 Then
    AdCel = Cel.MergeArea.Address
    Cel.UnMerge
    Range(AdCel) = Cel
  End If
Next
End Sub

A+
 

Yaloo

XLDnaute Barbatruc
Re : Dé fusionner les cellules et copier les valeurs.

Re,

Si l'on veut conserver le format de la cellule, avec cette macro :

VB:
Sub CelFusion()
Dim Cel As Range, AdCel$
For Each Cel In [A5].CurrentRegion
  If Cel.MergeArea.Cells.Count <> 1 Then
    AdCel = Cel.MergeArea.Address
    Cel.UnMerge
    Cel.Copy Range(AdCel)
  End If
Next
End Sub

A+
 

jose.carreira

XLDnaute Junior
Re : Dé fusionner les cellules et copier les valeurs.

Merci à tous deux.

Je ne sais quoi dire je suis bouche Bé.

Du coup mon problème est résolue reste à savoir laquelle je vais utiliser car elles sont toutes parfaites.

Je m’incline

Merci encore pour tout.
 

Discussions similaires