Copiar valores y conservar el formato dado mediante formato condicional

La siguiente macro permite copiar como valores todas las fórmulas en las celdas que usan formato condicional, permitiendo además conservar el formato dado por medio de formato condicional, pero ahora de manera estática, simplemente como formato de celda.

La macro se basa en un truco publicado por "sagrat" en el foro de Ayuda Excel:  Pegar color del formato condicional.

Sagrat menciona que se puede copiar el rango de datos con formato condicional a Word y luego copiarlo de vuelta a Excel, lo que hace que el formato dado por el formato condicional quede como formato de celda.

La macro, que se basa en este truco, crea una instancia invisible de Word y pasa a copiar a Word e inmediatamente a copiar de vuelta a Excel las celdas con formato condicional de cada una de las hojas del libro activo. Esto tiene 3 efectos:

1. Convierte todas las fórmulas de las celdas con formato condicional de cada hoja del libro activo a valores;
2. Convierte el formato condicional de todas las celdas con formato condicional de cada hoja del libro activo a formato de celda;
3. Usa la precisión visible en la celda. Es decir, si la celda con formato condicional tiene formato para mostrar dos decimales, pero el valor en la celda tiene más de dos decimales, tras ejecutar la macro, el valor resultante sólo tendrá los dos decimales visibles, perdiéndose los demás.

Sub BorrarFormatoCondicional_LibroActivo()


    Dim WordApp As Object
    Dim wsHoja As Excel.Worksheet
    Dim rngArea As Excel.Range
    Dim rngCeldasFormatoCondicional As Excel.Range
    
    
    On Error GoTo err_BorrarFormatoCondicional
    
    
    With Application
        .ScreenUpdating = False
        .StatusBar = "Creando instancia de Word..."
    End With
    
    
    Set WordApp = CreateObject("Word.Application")
    
    
    For Each wsHoja In ActiveWorkbook.Worksheets
    

        Set rngCeldasFormatoCondicional = wsHoja.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)

    
        If Not rngCeldasFormatoCondicional Is Nothing Then
        
            wsHoja.Select
    
            For Each rngArea In rngCeldasFormatoCondicional.Areas
        
                With rngArea
                    .Select
                    .Copy
                End With
                
                With WordApp
                    .documents.Add
                    With .Selection
                        .PasteSpecial
                        .wholestory
                        .Copy
                        .Delete
                    End With
                End With

                wsHoja.PasteSpecial "HTML"
                
            Next rngArea
              
        End If
        
    Next wsHoja
    
    
Salir:
    
    If Not WordApp Is Nothing Then
        WordApp.Quit False
        Set WordApp = Nothing
    End If
    
    With Application
        .StatusBar = False
        .ScreenUpdating = True
    End With
    
    Exit Sub
    
    
err_BorrarFormatoCondicional:
    
    If Err.Number = 1004 Then
        Resume Next
    Else
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, Err.Source
        Resume Salir
    End If
    
    
End Sub

Si sólo se desea copiar uno o varios rangos de una hoja, se puede probar de la siguiente forma, seleccionando cuando la macro lo pida los rangos en cuestión:

Sub BorrarFormatoCondicional_Seleccion()


    Dim WordApp As Object
    Dim rngTrabajo As Excel.Range
    Dim rngArea As Excel.Range
    Dim rngCeldasFormatoCondicional As Excel.Range
    
    
    On Error GoTo err_BorrarFormatoCondicional
    

    Set rngTrabajo = Application.InputBox(Prompt:="Por favor, seleccione el rango de celdas con el que desea trabajar.", _
                                          Title:="Fijar formato condicional", _
                                          Type:=8)
                                       
    Application.ScreenUpdating = False
    
    Set rngCeldasFormatoCondicional = rngTrabajo.SpecialCells(xlCellTypeAllFormatConditions)

    If Not rngCeldasFormatoCondicional Is Nothing Then
                      
        Set WordApp = CreateObject("Word.Application")
        
        For Each rngArea In rngCeldasFormatoCondicional.Areas
    
            With rngArea
                .Select
                .Copy
            End With
            
            With WordApp
                .documents.Add
                With .Selection
                    .PasteSpecial
                    .wholestory
                    .Copy
                    .Delete
                End With
            End With

            Selection.Parent.PasteSpecial "HTML"

        Next rngArea
                    
        Set rngCeldasFormatoCondicional = Nothing
        
    End If
        
    
    
Salir:
    
    If Not WordApp Is Nothing Then
        WordApp.Quit False
        Set WordApp = Nothing
    End If
    
    Application.ScreenUpdating = True
    
    Exit Sub
    
    
err_BorrarFormatoCondicional:
    
    If Err.Number <> 424 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbInformation, Err.Source
    End If
    
    Resume Salir
    
End Sub