Macro que copie renglones segun valores en columnas

Tengo el siguiente detalle. En un libro de excel tengo alrededor de miles de registros, con la siguiente estructura:
ColA ... Col E col F... Col AK col AL ... Col BD
xx dato dato valor1 valor2 ... Valor 3
La cosa es la siguiente quiero que se copie la fila completa tantas veces como sea siempre y cuando el dato de las columnas AK, AL... BD sean diferentes de cero.

1 Respuesta

Respuesta
1
Yo te aconsejo que siempre que hagas una pregunta seas lo mas explicito posible para que te podemos ayudar de la mejor manera, porque nosotros tenemos el conocimiento tecnico en macros, pero, no podemos adivinar sus nececidades, por ejemplo aqui en tu caso en concreto aclarame algunos puntos como:
- A donde se va a copiar la fila cuando cumpla con la condición, a otra hoja, a otra parte de la misma hoja, que inserte renglones hacia abajo, en fin hacia donde voy a copiar esos datos
- ¿Se tienen que evaluar las tres columnas al mismo tiempo? ¿O cómo? ¿Si AK es cero entonces que evalue AL y luego BD o en que orden?
-¿Cuándo copie las filas debe irlas pegando una debajo de otra o como?
Como te daras cuenta el exito de la ayuda consiste en que tan bien se formulen las preguntas. Aclarame los puntos que te expuse para que te pueda yo ayudar
Que tal;
Perdón por la falta...
Estos serían los criterios:
Mis datos los tengo en una hoja llamada DATOS
1.Solo se evaluaría una columna a la vez, es decir, evalua AK y si es diferente de cero copia la fila en una hoja separada (el nombre de esta hoja que se llame COPIA y que inicie en la columna A2
2. Luego, evalua la columna AL y si es diferente de cero sucede lo mismo que en punto 1(y pegaría en la A3, es decir, se pega hacia abajo del último registro copiado). y se recorre a la columna AM y así hasta la BD.
3. Si es cero no hace nada y se pasa a la siguiente fila (esto se debe a que si cualquiera de las columnas es cero las siguientes también serán cero).
... Espero que ayude con esto.
Sorry por los datos a explicar, no tengo mucha experiencia en esto de la programación.
Saludos y gracias por la ayuda.
Creo que no le entendí muy bien todavía a tu planteamiento, pero en un intento por ayudarte aqui te mando un código, solo copialo y pégalo a tu archivo, OJO: la hoja donde está tu base de datos debe llamarse DATOS y debes crear una nueva hoja que se llame COPIA (en mayúsculas las dos hojas). Si te entendí bien, no debes tener problemas al correr la macro. Y por favor no olvides calificar y cerrar la pregunta.
Sub copiar()
    Sheets("DATOS").Select
    Range("AK2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AL2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AM2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AN2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AO2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AP2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AQ2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AR2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AS2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AT2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AU2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AV2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AW2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AX2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AY2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("AZ2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("BA2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("BB2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("BC2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Range("BD2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("COPIA").Select
            Range("A2").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        Sheets("DATOS").Select
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub
Fue un esfuerzo para ayudarte, Podrías calificar y cerrar la pregunta

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Utilizar Find en macros o procedimiento similar

Necesitaría que me ayudarais a buscar los distintos nombres de una persona, copiar toda la fila donde aparece, pegarla en otra hoja. Esto con cada nombre que se encuentre igual al indicado por nosotros. Yo lo que he intentado son dos formas pero...
1 respuesta

Extraer filas excel (con condición) en otra hoja del libro...

Tengo una tabla a7 a n1000 llena de datos. A b c d e g ........n 7 nombre dirección situación articulo fabrica precio ... N Y quisiera extraer en hoja2 las filas que en la columna c "situación" ponga "ok" eliminándolas de la tabla de la hoja 1 y...
1 respuesta

Copiar a otra hoja en la ultima fila, si cumple condición

Nuevamente solicito su valiosa colaboración, tengo una base de datos muy extensa en la Hoja1, lo que deseo es una macro que copie en la ultima fila vacía de la hoja dos datos si cumple una condición, Ejemplo: Hoja1 A B C D 1 Ana 15 A22 CC 2 Mario 20...
1 respuesta

Macro buscar y recopilar datos en Excel

Tengo un botón en una la Hoja1 de Excel e información en esta misma hoja de los rangos (A5:F100), en la columna A del rango (A1:A100) tengo un numero 0 (cero) o también el numero 1 (uno), lo que necesito es que al momento de oprimir el botón me...
2 respuestas

Macro para copiar según nombre de hoja

Tengo una macro con una hoja de registros por filas (hoja total), de esta hoja, con una macro paso los registros que tienen el la columna B:B el nombre de una hoja, a la correspondiente hoja. Esta es la mcro que repito para cada nombre de hoja: Sub...
1 respuesta

Macro. Copiar filas según condición.

Agradecería también que me ayudara en este otro macro, he separado los dos mensajes para que la respuesta no sea demasiado compleja. Tengo una hoja en la que se han introducido una serie de registros. Quisiera copiar en otra hoja sólo aquellas filas...
1 respuesta

Filtro con hipervínculo

Tengo un fichero Excel con un montón de códigos numéricos que van desde el 00000 al 99999. Lo que quiero hacer es otro fichero Excel que al poner un valor en una celda que estará dentro del rango anterior, por ejemplo 11111, haciendo click en esta...
1 respuesta

Copiar rango de celdas a partir de la celda activa a otra hoja del mismo libro

Tengo un rango de celdas que contienen formulas que llenan la información de las celdas. Necesito copiar de este rango de celdas solo los valores de las celdas que se hayan poblado con información congruente o interesante. Para esto la columna A...
1 respuesta

¿Cómo modificar macro?

Esta macro lo que hace es básicamente copiar datos de una hoja a las otras dos hojas en un libro excel, pero cuando hay una formula copia la formula, ¿Cómo puedo hacer para que en lugar de copiar la formula, sólo copie los datos?. Gracias por su...
1 respuesta

Comparar 2 hojas y sacar una tercera

DAN tengo el siguiente caso: En un mismo archivo 3 hojas: Inventario, toma-física, sobrantes-faltante. Debo comparar la columna A de inventario con la columna A de toma-física y colocar lo que este en Inventario que no este en toma-física en la...
2 respuestas