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 SubTe 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ódigoEspero con la intencion de ser claro, no haber liado más el asunto.