Texto en negritas

[ColdGeorge]

Hola amigos

Nuevamente solicitando de su amable ayuda, tengo en un rango, ("J6:J36") algunas celdas en negritas, deseo copiar esos valores a A7 para abajo, el código que hallé aquí mismo es:

Dim c As Range
For Each c In Intersect(Columns("J"), ActiveSheet.UsedRange)
    If c.Font.Bold Then c.Offset(, -9).Value = c.Value
Next c

Tristemente los valores se mueven al rango deseado, pero en texto plano, es decir, sin negritas, ¿alguna sugerencia? gracias de antemano, saludos.

ColdGeorge

 

[Greg Truby]

Me gustaría ver su intento. Usted tiene toda información necesario allí mismo. ¿Cómo piensa usted que uno lo haría? Aquí le doy una pista.

Dim celItem As Range

For Each celItem In Intersect(Columns("J"), ActiveSheet.UsedRange).Cells
    With celItem
        If .Font.Bold Then
            .Offset(, -9).Value = .Value
            '// code to apply bold to target cell
        End If
    End With
Next celItem

 

[ColdGeorge]

Hola Greg

Bien, ya estoy en eso.

ColdGeorge

Me gustaría ver su intento. Usted tiene toda información necesario allí mismo. ¿Cómo piensa usted que uno lo haría? Aquí le doy una pista.

Dim celItem As Range

For Each celItem In Intersect(Columns("J"), ActiveSheet.UsedRange).Cells
    With celItem
        If .Font.Bold Then
            .Offset(, -9).Value = .Value
            '// code to apply bold to target cell
        End If
    End With
Next celItem

 

[ColdGeorge]

Hola

Después de una intensa sesión de intentar y fallar, esto es lo que conseguí:

Dim c As Range


For Each c In Range("J6:J36")
    If c.Font.Bold Then c.Offset(, -9).Value = c.Value
Next c


Range("A7:A47").Font.Bold = True

Tengo la certeza de que tal vez no sea la mejor forma, pero realiza lo que busco, pero estoy abierto a sugerencias, saludos.

ColdGeorge

 

[Greg Truby]

Lo que usted hizo va a poner en negritas (bold) todas las celdas en columna A [pues todas entre filas 7 y 47, no todas]. Si esto está bien, pues acabado entonces. Pero lo que esperaba ver era algo como el siguiente que cambia solamente las celdas en columna A donde las de columna J están en negritas.

Dim celItem As Range

For Each celItem In Intersect(Columns("J"), ActiveSheet.UsedRange).Cells
    With celItem
        If .font.Bold Then
            .Offset(, -9).Value = .Value
            .Offset(, -9).font.Bold = True
        End If
    End With
Next celItem

 

[ColdGeorge]

Hola Greg

Muchas gracias por tu observación, muy atinado tu comentario, saludos.

ColdGeorge

Lo que usted hizo va a poner en negritas (bold) todas las celdas en columna A [pues todas entre filas 7 y 47, no todas]. Si esto está bien, pues acabado entonces. Pero lo que esperaba ver era algo como el siguiente que cambia solamente las celdas en columna A donde las de columna J están en negritas.

Dim celItem As Range

For Each celItem In Intersect(Columns("J"), ActiveSheet.UsedRange).Cells
    With celItem
        If .font.Bold Then
            .Offset(, -9).Value = .Value
            .Offset(, -9).font.Bold = True
        End If
    End With
Next celItem