Comparar Varias Rangos en diferentes hojas y copiar a una hoja Resultado

"Para Dante Amor"

Buenas noches dante, como siempre gracias por adelantado y disculpa el retraso pero se complican a veces las cosas.

Siguiendo con la primera y buena ayuda recibida de la primera macro, necesito perfecionarla un poco más o coregir posible error mío que no consigo superar.

Tengo dos hojas, las cuales nombro.

"Validos" - contiene en el rango "B" todo lo que necesito comparar y el rango "C" de esta hoja necesito añadirlo al final de cada fila copiada.

"Nuevos" - contiene varias columnas de las cuales gracias a tu ayuda, se consigue crear tantas hojas como datos en el rango "D" - id_principal

Además necesito que es donde me encuentro atascado:

Comparar "Hoja Nuevos. Rango E" que contiene códigos de defininiciones de tipos de material con el r "Hoja Validos.rango B" y copiar fila a fila todos los registros en la hoja nueva creada añadiendo al final de cada fila copiada el valor del rango "C" de la hoja Válidos:

 Si "Hoja Validos.rango B" = "Hoja Nuevos.rango E"

Copio todo fila a fila "hoja Nuevos numero hoja id_principal creada"

En la hoja nueva creada añado al final "valor hoja Validos.Rango "C"

Uso parte del código, pero me quedo atascado y no consigo pasarlo.

Te adjunto todo el código que me enviaste inicialmente.

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

Te indico parte del código que he intentado modificar para crear la segunda parte y me veo atascado, incluyo mis comentarios de funcionamiento paso a paso verificado., puesto que solo modifico a partir del punto.

   'Obtiene los valores únicos
    ' en esta parte he insertado este código que lo dejo todo en forma de comentario
    if h1.columns("D:D").value = h2.columns("B:B") then ' comparo el valor de la hoja "Nuevos" con valor de la hoja "Validos" y si son "IGUALES" entonces
    ' AQUI ME GENERA ERROR - NO COINDIDEN LOS TIPOS,
    ' he probado también con
    ' If Range(h1("D:D").Value) = h2("B:B").Value Then ' --> Mismo error
    h3.Columns("D:D").Copy h3.Cells(1, uc + 2)' copia y añade al final
    h3.Range(h3.Cells(1, uc + 2), h3.Cells(uf, uc + 2)).RemoveDuplicates Columns:=1, Header:=xlYes
    'Crea una hoja por cada código

Espero con la intencion de ser claro, no haber liado más el asunto.

1 respuesta

Respuesta
1

No entendí.

Envíame tu archivo con 4 hojas. La hoja "nuevos", la hoja "validos" y 2 hojas de ejemplos de lo que quieres, en cada hoja de ejemplos explicas qué es lo que quieres.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Shamu Amon Ra

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas