Necesito crear un rango de datos de Excel a partir de otro.

Se trata de un rango con 5000 filas y 4 columnas. El criterio es que sólo he de tomar los valores de las 3 columnas correspondientes a aquellas filas en las que la primera columna tiene como valor 0.

He probado con BUSCARV pero no me sirve porque eso sólo me devuelve un rango del mismo tamaño en el que sí puedo marcar las filas cuyo primer valor sea distinto de 0 con una cadena de caracteres "ERROR" o un número 999, por ejemplo. Pero el rango resultante seguirá teniendo 5000 filas.

Lo que necesito es que el rango resultante se reduzca como consecuencia de que habrá muchas filas en las que la primera columna será distinta de 0 y esas filas he de desecharlas.

Espero haberme explicado bien

1 respuesta

Respuesta
1

Te mando mi solución. En mi ejemplo voy a suponer que esas 4 columnas son A, B, C y D. Y los datos empiezan desde A2 hacia abajo puesto que en la fila 1 tenemos un encabezado.

Ejecuta esta macro y lo tienes resuelto:

Sub quitar_filas()
'macro creada por Luis Mondelo
Range("a2").Select
Range("a65000").End(xlUp).Offset(1, 0).Value = "final"
Do While ActiveCell.Value <> "final"
If ActiveCell.Value <> 0 Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
ActiveCell.ClearContents
End Sub

recuerda finalizar y puntuar

Hola Luis,

Muchas gracias. Me funciona perfecto pero tengo que poner la macro en cada hoja (y tengo 300). Además, necesito juntar el contenido de todas ellas en una sola; es decir, poner las celdas de la primera, debajo las de la segunda, etc.

Muchas gracias de antemano

Vete probando esto y después seguimos hablando:

(Ahora te lo hará en TODAS las hojas de tu archivo)

Sub quitar_filas()
'macro creada por Luis Mondelo
for x=1 to sheets.count
sheets(x).select
Range("a2").Select
Range("a65000").End(xlUp).Offset(1, 0).Value = "final"
Do While ActiveCell.Value <> "final"
If ActiveCell.Value <> 0 Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
ActiveCell.ClearContents
next
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas