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
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
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
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
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 !!!!
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 :
VB:
Sub Sup()
With [D7].CurrentRegion
.UnMerge
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Delete xlUp
.CurrentRegion.Borders.Weight = xlThin 'facultatif
End With
End Sub