Macro Comparar Varias Rangos en varias hojas y copiar a una hoja Resultado

Mañanas a todos.

LLevo atascado en una Macro un cierto tiempo, puesto que llevo ya bastantes años sin programar y el pseudocódigo lo tengo claro, pero no consigo que me funcione como yo quiero.

Espero poder explicarme para que me puedan entender.

Dispongo de lo que serían dos hojas princiapales y luego quiero crear tantas hojas como valores dentro de un "Rango" de una de las hojas.

Datos de partida u Hojas PRINCIPALES

1 - Hoja "Nuevos", tengo varios campos que ya provienen de una macro que me funciona, en esta me interesan usar los siguiente rangos.

- Rango "D" que se llama CP o código propio-- "Contiene valores duplicados, Según los valores de este rango se creará una hoja nueva no duplicada.

- Rango "I" que se llama actividad.

-----------------------------------------------

COL A --------------- COL B ------------------- COL C ----------------- COL DE ----------- COL ... ------- COL I

02501 --------------- ESQUINERO --------- 10X50 ---------------- 146010 ----------- A ---------- 508

02502 ---------------- ESQUINERO --------- 22X50 --------------- 146010 ----------- B ---------- 508

02503 ---------------- CAMBIO NIVEL --------- 22X50 --------------- 146011 ----------- A ---------- 504

02504 ---------------- EMPOTRADO --------- 100 --------------- 146024 ----------- A ---------- 5413

2 - Hoja "Validos" que contiene unos valores en el rango "B" con los que comparar el rango "i" de la hoja "Nuevos"

--------------------------------------------------------

COL A --------------- COLB --------------------- COL C

01 --------------- 504 --------------------- Mat. Encofrado

02 ---------------- 508 --------------------- Mat. Terminación

45 ----------------- 5413 ------------------ mat. Transporte

3 - Hojas de resultados", se crearían tantas según el número duplicado del rango "D" de la hoja "nuevos"

-------------------------------------------------------------------------------------------------------------------------------------------------------------

¿Qué quiero Hacer?

Según valor Columna DE en "hoja nuevos"

P. Ejemplo -- > valor "146010"

Creo una hoja nueva que se llama "140610"

Activo "hoja válidos" y "hoja nuevos"

Recorriendo fila por fila "hoja nuevos"

     si "valor hoja.nuevos(columna I)" = "valor hoja.validos(col B)"

Selecciono toda la fila de la "hoja nuevos"

Selecciono el valor de la celda de la columna "C" de la hoja "validos"

Pego en hoja resultado "140610" toda fila añadiendo al final de la fila el valor de la celda "i, C" de la hoja válidos.

Que he conseguido.

He creado manualmente las 9 hojas que se me crearían porque no veía forma.

Y cómo no consigo generar la variable para los CP, y la actividad, solamente voy 1 a uno

-------------------------------------------------------------------------------------------------------------------------

Con los bucles "IF" he intentado probar que me haga varias condiciones usando "or" pero lo que me hace al final es copiara todo lo que coincide tanto con el valor puesto aquí como ejemplo.

Os dejo la secuencia que hasta el momento me funciona 1 a 1.


Sub Infor_clas()
   'inicializo la variable j
    j = 2
    i = 2
    'comienzo el bucle
    For i = 2 To 7000 ' número total de registros
        'activo la hoja donde están mis datos
        Sheets("Nuevos"). Activate
        '-------------------------------------------------------------------
        'compruebo que el valor del CP sea 146010 y que el valor de "i" pueda ser 504 o 508
        If Cells(i, "D").Value = "146010" And (Cells(i, "I").Value = "504") Or (Cells(i, "I").Value = "508") Then
            'copio la fila entera
            Range(Cells(i, "A"), Cells(i, "Q")). Copy
            'selecciono la fila completa que coindice con alguno de los valores de "I"
            Sheets("140610"). Activate
            Cells(j, "A").Select
            'pego la fila que hemos copiado
            ActiveSheet. Paste
            'aumento la variable j para que vaya a la siguiente fila
            'cuando encuentre una nueva fila que cumple con la condición de CP
            j = j + 1 ' - Incremento de la variable para el bucle hasta terminar filas
     '--------------------------------------------------------------------------------------
     ' No funciona el "else if" ni el Or (Cells(i,"i").value
     '--------------------------------------------------------------------------------------
     '- ElseIf Cells(i, "D").Value = "146011" And (Cells(i, "I").Value = "504") Or (Cells(i, "I").Value = "508") Then
            'copio la fila entera
     '- Range(Cells(i, "A"), Cells(i, "Q")). Copy
            'selecciono la fila completa que coindice con alguno de los valores de "I"
     '- Sheets("140611"). Activate
     '-   Cells(j, "A").Select
            'pego la fila que hemos copiado
     '- ActiveSheet. Paste
            'aumento la variable j para que vaya a la siguiente fila
            'cuando encuentre una nueva fila que cumple con la condición de CP
     '-   j = j + 1 ' - Incremento de la variable para el bucle hasta terminar filas
        End If ' -- fin del bucle if
    Next ' fin del bucle FOR
End Sub ' fin del procedimiento infor_clas

1 respuesta

Respuesta
1

Te anexo la macro.

Antes de ejecutar la macro crea una hoja llamada "Temp" y elimina las hojas de códigos que hayas creado.

Haz una prueba con 3 o 4 códigos y me dices si es lo que necesitas.

Sub Resultados()
'Por.Dante Amor
    '
    Application.ScreenUpdating = False
    Application.StatusBar = False
    '
    Set h1 = Sheets("Nuevos")
    Set h2 = Sheets("Validos")
    Set h3 = Sheets("Temp")
    h3.Cells.Clear
    '
    'Completa la fila con el dato de validos
    h1.Cells.Copy h3.Range("A1")
    uc = h3.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    uf = h3.Range("I" & Rows.Count).End(xlUp).Row
    With h3.Range(h3.Cells(2, uc), h3.Cells(uf, uc))
        .FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Validos!C2:C3,2,0),"""")"
        .Value = .Value
    End With
    '
    'Obtiene los valores únicos
    h3.Columns("D:D").Copy h3.Cells(1, uc + 2)
    h3.Range(h3.Cells(1, uc + 2), h3.Cells(uf, uc + 2)).RemoveDuplicates Columns:=1, Header:=xlYes
    'Crea una hoja por cada código
    u3 = h3.Cells(Rows.Count, uc + 2).End(xlUp).Row
    For i = 2 To u3
        Application.StatusBar = "Creando hoja : " & i & " de : " & u
        cod = h3.Cells(i, uc + 2)
        Sheets.Add after:=Sheets(Sheets.Count)
        Set h4 = ActiveSheet
        h4.Name = cod
        If h3.AutoFilterMode Then h3.AutoFilterMode = False
        h3.Range(h3.Cells(1, "A"), h3.Cells(uf, uc)).AutoFilter Field:=4, Criteria1:=cod
        h3.Range(h3.Cells(1, "A"), h3.Cells(uf, uc)).Copy h4.Range("A1")
    Next
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Muy buenas Tardes Dante.

 Ante todo muchísimas gracias.

Funciona a la perfección, lo único que no me funciona, es añadir al final de cada fila copiada, por ejemplo "146010" la definición de lo que es cada actividad, que está en el rango "c" de la hoja "validos", ya que lo considero por si alguno cuando lea el informe que genero, tiene que saber ....

Un Saludo y gracias.

Pero en la misma fila en la columna D ya tienes ese dato.

Podrías poner un ejemplo de lo que te hace falta. Dime cómo quedan las hojas y cómo quieres el resultado.

No olvides valorar la respuesta.

Buenas Noches Dante.

 Disculpa el retraso en contestar pero por laburo me ha resultado conectarme de nuevo ayer.

  Muchas gracias por todo, te comento:

  Ya sé que el dato se encuentra en la columna "D", pero lo que quiero es añadir de

       hoja.validos (celda.rango C) al final de la fila copiada en hoja.resultado(fila copiada)

ya que alguno cuando tenga que leer el informe que es lo que estoy generando, seguro que necesita saber lo que son los códigos, y por si acaso ya se lo dejo al final del todo.

Un Saludo y muchas gracias.

No entiendo.

Puedes poner un ejemplo de lo que te deja la macro y qué es lo que quieres adicionar, explicado con un ejemplo.

Buenas noches Dante, disculpa la demora, espero que con la imagen que te he adjuntado pueda servirte, ante todo gracias por la ayuda.

Puesto que con tu macro, estoy resolviendo más resultados en otros informes similares, modificando las columnas y rangos que preciso.

Moviste los datos.

En tu primer ejemplo pusiste el código 508 en la columna "i", también lo escribiste aquí:

2 - Hoja "Validos" que contiene unos valores en el rango "B" con los que comparar el rango "i" de la hoja "Nuevos"

Pero ahora en tu imagen aparece el código 508 en la columna "e"

La macro funciona correctamente con los datos tal cual los pusiste en tu primer ejemplo.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas