Macro para copiar celdas en base a una condición

Tengo un excel como un checklist con valoración máxima, lo que requiero es que cuando esta no se cumpla se copie las celdas (donde se evidencia el no cumplimiento) en una hoja distinta (llamada Resumen), lo único es que no deseo que queden filas vacías, solo aquellas que no se cumplan deberán copiarse.

Por ejemplo en esta imagen se observa que no cumple las preguntas 1 y 4, entonces en la hoja 1 debería dar el siguiente resultado:

Este es un ejemplo simple pero en si son más de 180 preguntas, con fórmulas lo he logrado pero me quedan filas en blanco de aquellas que si se cumplen, posible realizarlo con una Macro, ¿me ayudarían indicándome como?

1 respuesta

Respuesta

He puesto como si la tabla de checklist y de resumen empezaran por la columna A, no sé como lo tendrás puesto tú

Aquí tienes el código de la sub. Lo que hace la sub es mirar donde el answer es 0.

La variable fila_resumen indica las filas que se han ocupado que hay en la hoja de resumen

Private Sub CommandButton1_Click()
    Dim i As Integer
    Dim fila_resumen As Integer
    i = 2
    fila_resumen = 2
    With Sheets("Checklist")
        While (.Range("C" + CStr(i)) <> "")
            If (.Range("C" + CStr(i)) = 0) Then
                'Columna topic notes, cambia la B por la columna que lo tengas tú
                'La A es la columna en la hoja resumen, cambiala si quieres otra columna
                'Lo mismo para las demás
                Sheets("Resumen").Range("A" + CStr(fila_resumen)) = .Range("B" + CStr(i))
                Sheets("Resumen").Range("B" + CStr(fila_resumen)) = 0
                'Columna Observaciones, cambia la E por la columna en que lo tengas tú
                Sheets("Resumen").Range("C" + CStr(fila_resumen)) = .Range("E" + CStr(i))
                fila_resumen = fila_resumen + 1
            End If
            i = i + 1
        Wend
    End With
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas