Sub CombinarTextoEntreEspaciosEnBlanco()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim combinedText As String
Dim targetCell As Range
Dim firstLine As String
' Establecer la hoja de trabajo en la que se encuentra tu rango de datos
Set ws = ThisWorkbook.Sheets("NombreDeTuHoja")
' Establecer el rango que contiene los datos
Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
' Inicializar la celda objetivo donde se combinará el texto
Set targetCell = ws.Range("Z1") ' Cambia "Z1" al rango de celda donde deseas que aparezca el resultado
' Inicializar el texto combinado y la primera línea
combinedText = ""
firstLine = ""
' Iterar a través de cada celda en el rango
For Each cell In rng
' Si la celda está vacía, pegar el texto combinado en la celda objetivo y reiniciar las variables
If cell.Value = "" Then
If Len(combinedText) > 0 Then
' Pegar el texto combinado en la celda objetivo
targetCell.Value = combinedText
' Hacer que la primera línea esté en negrita
targetCell.Characters(Start:=1, Length:=Len(firstLine)).Font.Bold = True
' Mover la celda objetivo a la siguiente fila
Set targetCell = targetCell.Offset(1, 0)
' Reiniciar las variables
combinedText = ""
firstLine = ""
End If
Else
' Si la celda no está vacía, agregar su valor al texto combinado
If combinedText = "" Then
' Si es la primera línea, guardarla para formatearla en negrita después
firstLine = cell.Value
Else
' Agregar salto de línea si no es la primera línea
combinedText = combinedText & vbCrLf
End If
' Agregar el valor de la celda al texto combinado
combinedText = combinedText & cell.Value
End If
Next cell
' Pegar el último texto combinado después del último espacio en blanco
If Len(combinedText) > 0 Then
targetCell.Value = combinedText
' Hacer que la primera línea esté en negrita
targetCell.Characters(Start:=1, Length:=Len(firstLine)).Font.Bold = True
End If
End Sub
(Pasted and working from Chatgpt)
The problem is that inside the same row there are words written in different fonts, and they result of the script appears as a single font.
Is there any way to fix that?
Thanks in advance for your time!
(And sorry for double posting)