Macro para Consolidar datos de Hojas distintas
Necesito generar un código VBA (o macro) para lo siguiente. Necesito que recorra una base y que, cuando encuentre un parámetro determinado (numero de registro existente en otra base) reemplace la línea completa. Es decir:
- Que tome la celda B2 (línea 1 con títulos, por eso parte en la B2) de la Hoja 1
- Recorra la columna B de la Hoja 2
- Cuando encuentre el parámetro de B2(Hoja 1) en la Columna B(Hoja 2), reemplace la línea completa.
- Así con todos los registros de la Hoja 1
Tener en consideración que es una base grande, por lo que el procedimiento debe ser optimizado para ello.
H o l a
prueba esto y me comentas
Sub comparar()
'//Por Aortiz
'
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
'
Set b = h1.Cells(i, "B").Find(h2.Cells(i, "B"), lookat:=xlWhole)
'
If Not b Is Nothing Then
h1.Rows(i).Copy h2.Rows(i)
End If
Next i
MsgBox "fin", vbInformation
'
End SubValora la respuesta para finalizar saludos!
Gracias estimado, pero la verdad es que no funciona. Solo aplica cuando la primera línea de Hoja1 es igual a la primera de Hoja2, y no lo hace con el resto (solo una linea por ejecución)
Envíame tu archivo [email protected] para ver como esta organizado tus datos. Y me explicas con detalle lo que necesitas saludos!
Estoy confundido, en la macro modificada veo que comparas la columna "Z" pero dijiste que era la "B", dime cual columna comparar y los resultado que deseas saludos!
Lo que pasa es que la acomodé. En el archivo es la Z.
En la pregunta dice "Hoja1" y en el archivo esta es DB_REPORT.
En la pregunta dice "Hoja2" y en el archivo esta es DB_DIG.
En la pregunta dice "Columna B(Hoja2)" y en el archivo es Columna Z(Hoja DB_DIG).
H o l a
Te paso la macro, disculpa la demora
Sub comparar()
'//Por Aortiz
'
Set h1 = Sheets("DB_REPORT")
Set h2 = Sheets("DB_DIG")
'
For i = 2 To h2.Range("Z" & Rows.Count).End(xlUp).Row
Set b = h1.Columns("Z").Find(h2.Cells(i, "Z"), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(i, "A") = h1.Cells(b.Row, "A")
h2.Cells(i, "B") = h1.Cells(b.Row, "B")
h2.Cells(i, "C") = h1.Cells(b.Row, "C")
h2.Cells(i, "D") = h1.Cells(b.Row, "D")
h2.Cells(i, "E") = h1.Cells(b.Row, "E")
h2.Cells(i, "F") = h1.Cells(b.Row, "F")
h2.Cells(i, "G") = h1.Cells(b.Row, "G")
h2.Cells(i, "H") = h1.Cells(b.Row, "H")
h2.Cells(i, "I") = h1.Cells(b.Row, "I")
h2.Cells(i, "J") = h1.Cells(b.Row, "J")
h2.Cells(i, "K") = h1.Cells(b.Row, "K")
h2.Cells(i, "L") = h1.Cells(b.Row, "L")
h2.Cells(i, "M") = h1.Cells(b.Row, "M")
h2.Cells(i, "N") = h1.Cells(b.Row, "N")
h2.Cells(i, "O") = h1.Cells(b.Row, "O")
h2.Cells(i, "P") = h1.Cells(b.Row, "P")
h2.Cells(i, "Q") = h1.Cells(b.Row, "Q")
h2.Cells(i, "R") = h1.Cells(b.Row, "R")
h2.Cells(i, "S") = h1.Cells(b.Row, "S")
h2.Cells(i, "T") = h1.Cells(b.Row, "T")
h2.Cells(i, "U") = h1.Cells(b.Row, "U")
h2.Cells(i, "V") = h1.Cells(b.Row, "V")
h2.Cells(i, "W") = h1.Cells(b.Row, "W")
h2.Cells(i, "X") = h1.Cells(b.Row, "X")
h2.Cells(i, "Y") = h1.Cells(b.Row, "Y")
h2.Cells(i, "Z") = h1.Cells(b.Row, "Z")
End If
Next i
MsgBox "fin", vbInformation
'
End SubValora la respuesta para finalizar saludos!
No resulta amigo... Solo elimina la infor de la hoja DB_DIG (limpia las celdas) pero no pasa la información a la otra hoja (DB_REPORT)
Te explico lo que hace la macro.
Compara la columna Z de la hoja "DB_DIG" con la columna Z de la hoja DB_REPORT, si encuentra coincidencia actualiza todos los valores de la fila encontrada de la hoja DB_DIG.
Como te muestro en la imagen en la hoja db_report encontró coincidencia "00004-1000621-01-01-0001-000001345-000001346" y copia todo los valores a la hoja DB_DIG en la fila correspondiente.
Te envié el archivo.
Tal vez falta algunos ajustes, explica con alguno detalles e imágenes como deseas el resultado
Ahhh ok, perfecto. Dejame probar porque el cambio es a la inversa.
Te comento en unos momentos.
Slds.
Te paso la macro actualizada lo hice a la inversa
Sub comparar()
'//Por Aortiz
'
Set h1 = Sheets("DB_REPORT")
Set h2 = Sheets("DB_DIG")
'
For i = 2 To h1.Range("Z" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("Z").Find(h1.Cells(i, "Z"), lookat:=xlWhole)
If Not b Is Nothing Then
h1.Cells(i, "A") = h2.Cells(b.Row, "A")
h1.Cells(i, "B") = h2.Cells(b.Row, "B")
h1.Cells(i, "C") = h2.Cells(b.Row, "C")
h1.Cells(i, "D") = h2.Cells(b.Row, "D")
h1.Cells(i, "E") = h2.Cells(b.Row, "E")
h1.Cells(i, "F") = h2.Cells(b.Row, "F")
h1.Cells(i, "G") = h2.Cells(b.Row, "G")
h1.Cells(i, "H") = h2.Cells(b.Row, "H")
h1.Cells(i, "I") = h2.Cells(b.Row, "I")
h1.Cells(i, "J") = h2.Cells(b.Row, "J")
h1.Cells(i, "K") = h2.Cells(b.Row, "K")
h1.Cells(i, "L") = h2.Cells(b.Row, "L")
h1.Cells(i, "M") = h2.Cells(b.Row, "M")
h1.Cells(i, "N") = h2.Cells(b.Row, "N")
h1.Cells(i, "O") = h2.Cells(b.Row, "O")
h1.Cells(i, "P") = h2.Cells(b.Row, "P")
h1.Cells(i, "Q") = h2.Cells(b.Row, "Q")
h1.Cells(i, "R") = h2.Cells(b.Row, "R")
h1.Cells(i, "S") = h2.Cells(b.Row, "S")
h1.Cells(i, "T") = h2.Cells(b.Row, "T")
h1.Cells(i, "U") = h2.Cells(b.Row, "U")
h1.Cells(i, "V") = h2.Cells(b.Row, "V")
h1.Cells(i, "W") = h2.Cells(b.Row, "W")
h1.Cells(i, "X") = h2.Cells(b.Row, "X")
h1.Cells(i, "Y") = h2.Cells(b.Row, "Y")
h1.Cells(i, "Z") = h2.Cells(b.Row, "Z")
End If
Next i
MsgBox "fin", vbInformation
'
End Subvalora la respuesta para finalizar saludos!
