Excel vba mesclar celulas

[Netrox92]

Ola

Gostaria de saber se tem algum jeito de verificar até onde está escrito um texto em uma célula, e mesclar com as celulas até onde está escrito.

 

Exemplo:

 

No texto: "Texto aleatório, para teste." está escrito na celula 'A1', porém o texto vai até o começo da celula 'F1".

Gostaria de um código vba para verificar até onde o texto está escrito, e mesclar até a celula correta. No exemplo mesclaria da celula 'A1:F1'

 

Agradeço desde já

 

Abraços

[Basole]

Tente o codigo abaixo, insira em um modulo: 

 

Sub Mesclar_Celulas()

Dim rngA, L, x, y, v, w
rngA = 1
w = IsMerged(Plan1.[a1])
If w = True Then
MsgBox " Celula selecionada já está mesclada"
Exit Sub
Else
x = Len(Plan1.[a1])
v = Width(Plan1.[a1])
y = x / v
If Len(y) > 1 Then L = Left(y, InStr(y, ",") - 1)
If Len(y) = 1 Then L = Left(y, 1)
If L > 1 Then Range(Cells(1, rngA), Cells(1, (L - 1))).Select
If L <= 1 Then Range(Cells(1, rngA), Cells(1, rngA + (L))).Select
If Selection.Cells.count > 1 Then
Selection.Merge
MsgBox (L - 1) & " Celulas selecionadas mescladas"
Else
MsgBox "Para mesclar, é preciso de ao menos 2 ou mais células selecionadas!", 64
End If
End If
End Sub

Function Width(MyRange As Range) As Double
Application.Volatile
Width = MyRange.ColumnWidth
End Function
Function IsMerged(rCell As Range) As Boolean
IsMerged = rCell.MergeCells
End Function