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.