XL 2016 Autofit de plusieurs cellules fusionnées via vba

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Range
    For Each cell In Range("A1:A18")
        If cell Like "Article #*" Then
            With cell.MergeArea
                .UnMerge 'défusionne
                .Font.Bold = True
                .EntireColumn.AutoFit
                .Merge 'refusionne
            End With
        End If
    Next cell
End Sub

Option Explicit

Sub HauteurLigneMergeArea(MergedZone As Range)
  Dim Zone1Cel As Range
  Dim Ind As Long
  Dim LargeurTotale As Single
  ' Désactiver les événements
  Application.EnableEvents = False
  ' Définir la cellule qui va contenir le texte
  Set Zone1Cel = ActiveSheet.Range("Z" & MergedZone.Row)
  'Déterminer la largeur totale de la zone fusionnée
  For Ind = 1 To MergedZone.Columns.Count
    LargeurTotale = LargeurTotale + MergedZone.Columns(Ind).ColumnWidth
  Next
  ' Appliquer la largeur totale à la colonne 1
  Zone1Cel.ColumnWidth = LargeurTotale - 1
  ' Inscrire dedans le texte
  Zone1Cel.Value = MergedZone.Cells(1, 1).Value
  ' Appliquer le retour à la ligne de la cellule unique
  ' et son ajustement automatique
  With Zone1Cel
    .WrapText = False
    .WrapText = True
    .Rows.AutoFit
  End With
  ' Forcer la hauteur de ligne
  MergedZone.RowHeight = Zone1Cel.RowHeight
  ' Effacer le contenu de la cellule unique
  Zone1Cel.Clear
  ' Réactiver les événements
  Application.EnableEvents = True
End Sub

Sub MettreEnForme()
    Dim cell As Range
    Dim searchText As String
    Dim startPos As Integer
    Dim numberPart As String
    Dim Target As Range
    
    ' Définir le texte à rechercher
    searchText = "Article "
    
    ' Parcourir chaque cellule dans la plage A1:A18
    For Each cell In Range("A1:A18")
        ' Vérifier si la cellule commence par le texte recherché
        If Left(cell.Value, Len(searchText)) = searchText Then
            ' Trouver la position du premier espace après "Article +"
            startPos = Len(searchText) + 1
            Do While Mid(cell.Value, startPos, 1) <> " " And startPos <= Len(cell.Value)
                startPos = startPos + 1
            Loop
            
            ' Extraire le numéro après "Article +"
            numberPart = Mid(cell.Value, Len(searchText) + 1, startPos - Len(searchText) - 1)
            
            ' Mettre "Article +N" en gras
            cell.Characters(Start:=1, Length:=Len(searchText) + Len(numberPart)).Font.Bold = True
            
            ' Si la cellule a du texte après "Article +N", le laisser en normal (non gras)
            If Len(cell.Value) > Len(searchText) + Len(numberPart) Then
                cell.Characters(Start:=Len(searchText) + Len(numberPart) + 1).Font.Bold = False
            End If
            
            ' Ajuster la largeur de la cellule
            cell.Rows.AutoFit
        End If
    Next cell
    
    ' Ajuster la hauteur des lignes des cellules fusionnées dans la plage A1:A15
    On Error Resume Next
    For Each cell In ActiveSheet.Range("A1:A15")
        Set Target = cell
        If Not Target Is Nothing Then Call HauteurLigneMergeArea(Target.MergeArea)
    Next cell
    On Error GoTo 0
End Sub