Renvoi à la ligne des cellules fusionnées

[billouu]

Bonjour,

Voila j'ai cette macro qui me permet de renvoyer a la ligne le contenu des cellules fusionnées.
Elle fonctionne assez bien le seul HIC, c'est lorsque je supprime le contenu d'un cellule une erreur se produit, sauf si mon curseur est situé à l'intérieur et que je supprime les lettres une par une, mais la cellule ne s'ajuste pas d'elle même.

Voila merci d'avance, en espérant que quelqu'un pourra m'aider.




Private Sub Worksheet_Change(ByVal activecell As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If activecell.MergeCells Then
With activecell.MergeArea
.WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
If .Rows.Count = 1 Then 'And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = activecell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub