XL 2013 code qui de-fusionne des cellules dans un tableau

patricktoulon à dit:

EN l'état si je me cantonne a ta demo
pour la reproduire je fait ceci

VB:

Sub test()
    Dim D As Object, C As Range
    Set D = CreateObject("scripting.dictionary")
    For Each C In Range("D1", Cells(Rows.Count, "D").End(xlUp)).Cells
        If C.MergeCells = True And Not D.exists(C.MergeArea.Address) Then
            D(C.MergeArea.Address) = C.Value
        End If
    Next
    [G8].Resize(D.Count, 1) = Application.Transpose(D.Items)
End Sub

mais je suis quasiment certain que c'a n'est pas tout a fait ça ,mais comme a ton habitude tu va nous donner les éléments 1 par 1 😉

Cliquez pour agrandir...

patricktoulon à dit:

re

VB:

Sub test()
    Dim D As Object, C As Range,firstrow&
    Set D = CreateObject("scripting.dictionary")
    For Each C In Range("D1", Cells(Rows.Count, "D").End(xlUp)).Cells
        If C.MergeCells = True And Not D.exists(C.MergeArea.Address) Then
            If firstrow = 0 Then firstrow = C.Row
            D(C.MergeArea.Address) = C.Value: C.MergeCells = False: C = ""
      
End If
    Next
    Cells(firstrow, "D").Resize(D.Count, 1) = Application.Transpose(D.Items)
End Sub

Cliquez pour agrandir...

patricktoulon à dit:

re
et quoi que!!!!
si d'autre données sur la feuille vérifier si ça les fait pas remonter injustement

Cliquez pour agrandir...

job75 à dit:

Bonjour vinciHorus, patricktoulon, le forum,

Rien compris mais puisqu'on demande de défusionner :

VB:

Sub Sup()
With Range("D8:D" & Rows.Count)
    .UnMerge
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).Delete xlUp
    .CurrentRegion.Borders.Weight = xlThin 'facultatif
End With
End Sub

A+

Cliquez pour agrandir...