XL 2016 Copier coller format : probleme cellule fusionnée

nicroq

XLDnaute Occasionnel
Bonjour à tous,

Un probleme s'oppose à moi pour réaliser un copier coller (pasteformat) en VBA d'une ligne entière dans une feuille ayant des cellules fusionnée dans une colonne.

Existe t il une solution pour contourner le probleme par exemple détécter si il y a une cellule fusionnée sur lepasteformat, puis défusionner et refusionner ensuite au meme endroit avec une ligne en plus du coup?

Merci pour votre aide.
Je mets en PJ un fichier très simplifié avec l'hypothèse que je souhaiterai copier la ligne 3 de la sheet "feuil copie" vers la feuille sheet "feuille paste" en ligne 8 en pasteformat.

Bonne journée
 

Pièces jointes

  • test copie colle cellule fusionnée.xlsx
    9.9 KB · Affichages: 6

nicroq

XLDnaute Occasionnel
Bonjour sylvanu!
Cest clair que les cellules fusionnées c est vraiment la peste ca complique tt...
du coup vous auriez une solution pour detecter les cellules fusionnées et le remttre en place comme dan l exemple du fichier joint?

en vous remerciant
Cordialement
Roques Nicolas
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
J'ai trouvé çà :
Code:
If c.MergeCells Then MsgBox c.MergeArea.Address
ou encore :
VB:
If Cells(1,1).MergeArea.Count > 1 Then MsgBox "Fusionné" Else MsgBox "Pas fusionné"
Mais ensuite il va falloir analyser combien de cellules sont fusionnées, calculer les colonnes où coller.
Bref l'usine.
D'où ma suggestion de supprimer les cellules fusionnées.
 

job75

XLDnaute Barbatruc
Bonjour nicroq, sylvanu,

Je m'en suis toujours sorti avec les cellules fusionnées, voyez le fichier joint et cette macro :
VB:
Sub CopierColler()
Dim Source As Range, Dest As Range, memsel, rc&, cc%, i&, j%
Set Source = Sheets("feuil copie").[3:3]
Set Dest = Sheets("feuille paste ").[8:8]
Application.ScreenUpdating = False
Set memsel = Selection
With Intersect(Dest, Dest.Parent.UsedRange)
    rc = .Rows.Count: cc = .Columns.Count
    For i = 1 To rc
        For j = 1 To cc
            If Not .Cells(i, j).MergeCells Then
                Source.Cells(i, j).Copy
                .Cells(i, j).PasteSpecial xlPasteFormats
            End If
    Next j, i
End With
Application.CutCopyMode = 0
memsel.Select
End Sub
PS : il y a un espace inutile dans le nom "feuille paste ".

A+
 

Pièces jointes

  • test copie colle cellule fusionnée(1).xlsm
    18.7 KB · Affichages: 6

Discussions similaires

Haut Bas