[Tasos]

Καλημέρα σε όλους!
Μάκη, για την περιοχή AQ4:BW500 του επιλεγμένου φύλλου, βάλε τον παρακάτω κώδικα σε μια κοινή λειτουργική μονάδα και δοκίμασε:

Option Explicit

Sub MergeFoundCells()
    Dim SearchString
    Dim CurrAddress As String
    Dim MainRange As Range
    Dim rng As Range
    Dim AddrArray As Variant
    Dim i As Long
    Set MainRange = Range("AQ4:BW500")
    SearchString = "m"
    Set rng = MainRange.Find(SearchString, LookIn:=xlValues)
    If Not rng Is Nothing Then
        CurrAddress = rng.Address
    Else
        Exit Sub
    End If
    Do
        If Not rng.MergeCells Then
            If Trim(rng.Offset(-1)) = vbNullString Then
                AddrArray = AddrArray & ";" & rng.Address
            End If
        End If
        Set rng = MainRange.FindNext(rng)
    Loop While Not rng Is Nothing And rng.Address <> CurrAddress
    AddrArray = Split(AddrArray, ";")
    For i = 1 To UBound(AddrArray)
        Set rng = Range(Range(AddrArray(i)), Range(AddrArray(i)).Offset(-1))
        rng.Merge
        rng.HorizontalAlignment = xlCenter
        rng.VerticalAlignment = xlCenter
        With rng.Font
            .Name = "Arial"
            .Size = 18
            .Bold = True
        End With
    Next
End Sub

Φιλικά

Τάσος