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
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
