XL 2013 code qui de-fusionne des cellules et le transforme

sylvanu à dit:

Bonjour VinciHorus,
un essai en PJ avec cette macro :

VB:

Sub Essai()
L = 20  ' N° ligne de destination
For Each c In Range("D7:D18")
    If c <> "" Then
        Range("H" & L) = c
        Range("I" & L) = Cells(c.Row, c.Column + 1)
        L = L + 1
    End If
Next
End Sub

Cliquez pour agrandir...

job75 à dit:

Bonjour,

Bah pourquoi n'être pas resté sur ce fil :

https://www.excel-downloads.com/thr...lules-dans-un-tableau.20045989/#post-20338061

L'adaptation est pourtant évidente :

VB:

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

A+

Cliquez pour agrandir...

sylvanu à dit:

Bonjour,
Un autre essai.

Cliquez pour agrandir...

sylvanu à dit:

Voila.

Cliquez pour agrandir...

vinciHorus à dit:

Vu que quand je l'adapte certaines données sur la feuille remontent injustement !!! j'ai essayé de mieux formuler !!! actuellement j'essaye de fixer mais c'est toujours pareil !!!!

Cliquez pour agrandir...

Sub Sup()
With [D7].CurrentRegion
    .UnMerge
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).Delete xlUp
    .CurrentRegion.Borders.Weight = xlThin 'facultatif
End With
End Sub