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

[vinciHorus]

Bonjour

J'aimerais avoir un code qui de-fusionne des cellules dans un tableau comme indiqué dans ce fichier joint

merci

 

[sylvanu]

Bonjour VinciHorus,
un essai en PJ avec cette macro :

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

 

[vinciHorus]

Bonjour VinciHorus,
un essai en PJ avec cette macro :

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

Merci pour la reponse rapide

est ce possible que le nouveau tableau vient remplacer l'ancien

 

[job75]

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 :

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+

 

[vinciHorus]

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 :

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+

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 !!!!

 

[sylvanu]

Bonjour,
Un autre essai.

 

[vinciHorus]

Bonjour,
Un autre essai.

exactement cela !!!

j'essaye de l'adapter sur ce fichier sans succès peux tu m'aider

 

[sylvanu]

Voila.

 

[vinciHorus]

Voila.

merci

 

[job75]

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 !!!!

Quelles données injustes ??? Après les cellules fusionnées ? Essayez donc :

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