Ajustar texto celdas combinadas según celda activa

Dias atras hize esta misma pregunta o parecida y recibi respuesta de Uds donde me indicaban accediera al codigo que mas abajo inserto:
Este codigo funciona perfectamente en dicho rango pero yo necesito que lo haga a partir de la celda activa (NO SOY CAPAZ DE ADAPTARLO)
En mi caso la celda activa estaría en cualquier fila de la columna "D" y debo combinar dicha celda hasta la columna "J" y posteriormente Ajustar la celda combinada a la altura que ocupe el texto. (Con esto seria suficiente), pero si luego se bajara a la siguiente celda dentro de la columna "D" que tenga datos y repite la operación seria fabuloso.
Alguien por favor puede adaptarme este u otro código para que realice esta tarea
Gracias anticipadas
Sub AjustarTextoEnCeldasCombinadas()
'Si el rango B5:E5 de la hoja activa no esta combinado, salir sin hacer nada
If Not ActiveSheet.Range("B5:E5").MergeCells Then Exit Sub
Dim sngAnchoTotal As Single, sngAnchoCelda As Single, sngAlto As Single
Dim n As Integer
For n = 2 To 5
sngAnchoTotal = sngAnchoTotal + ActiveSheet.Cells(5, n).ColumnWidth
Next n
With ActiveSheet.Range("B5")
sngAnchoCelda = .ColumnWidth
.HorizontalAlignment = xlJustify
.VerticalAlignment = xlJustify
.MergeCells = False
.ColumnWidth = sngAnchoTotal
ActiveSheet.Rows(5).AutoFit
sngAlto = .RowHeight
End With
With ActiveSheet
.Range("B5:E5").Merge
.Columns(2).ColumnWidth = sngAnchoCelda
.Rows(5).RowHeight = sngAlto
End With
End Sub

{"lat":39.2834350433546,"lng":-2.79235124588013}