1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
| Sub FUSIONNER()
'
' FUSIONNER Macro
'Fonction permettant de fusionner les lignes d'une colonne dans une seule cellule _
en gardant la mise en page
' Touche de raccourci du clavier: Ctrl+q
Dim Colonne As Long
Dim Ligne As Long
Dim ColonneFin As Long
Dim LigneFin As Long
Dim ResultCell As Variant
With Selection
Ligne = .Cells(1).Row
LigneFin = .Cells(.Cells.Count).Row
Colonne = .Cells(1).column
ColonneFin = .Cells(.Cells.Count).column
End With
For i = Colonne To ColonneFin
ResultCell = ""
For j = Ligne To LigneFin
Range(Chr(64 + i) & CStr(j)).Select
ch = Chr(10)
If j = LigneFin Then ch = ""
ResultCell = ResultCell & ActiveCell.FormulaR1C1 & ch
ActiveCell.FormulaR1C1 = ""
Next j
Range(Chr(64 + i) & CStr(Ligne), Chr(64 + i) & CStr(j - 1)).Merge
Range(Chr(64 + i) & CStr(Ligne), Chr(64 + i) & CStr(j - 1)).WrapText = True
Range(Chr(64 + i) & CStr(Ligne)).FormulaR1C1 = ResultCell
Next i
Range(Chr(64 + Colonne + 1) & CStr(Ligne), Chr(64 + ColonneFin) & CStr(LigneFin)).Select
'Selection.Delete Shift:=xlToLeft
End Sub |
Partager