Macro Comparativo para buscar y no repetir datos
Necesito un macro para comparar dos hojas de trabajo
En la hoja principal que llamo inventario tengo las siguientes columnas.
Las hotras dos hojas las llamo "bd_1" y "bd2".
Copio la "bd_1" a la hoja "inventario" con este macro:
Sub copia_spectrum()
r = 2
Do While Sheets("bd_1").Cells(r, 1).Value <> ""
Sheets("Inventario").Cells(r, 1).Value = Sheets("bd_1").Cells(r, 5).Value
Sheets("Inventario").Cells(r, 2).Value = Sheets("bd_1").Cells(r, 8).Value
Sheets("Inventario").Cells(r, 3).Value = Sheets("bd_1").Cells(r, 10).Value
Sheets("Inventario").Cells(r, 4).Value = Sheets("bd_1").Cells(r, 3).Value
Sheets("Inventario").Cells(r, 5).Value = 1
r = r + 1
Loop
End Sub
Con esto copeo los datos que me interesan en la "bd_1" y marco con 1 la columna 5 para afirmar que los datos están en la "bd_1.
En inventario las columnas van así:
(1)marca, (2)modelo, (3)numero de serie, (4)dirección y (5)bd_1
Una ves que tengo los datos de "db_1" paramos a la otra parte
Que seria comparar los datos de tengo en "inventario" con los que tengo en "bd_2",
Una vez comparados, copiar los datos de "bd_2" si no existen
Las columnas que quiero copiar de bd_2 son:
(7)marca, (8)modelo, (5)numero de serie,(12)dirección
Y los datos que si se pueden repetir serian marca y modelo, pero no puedo repetir numero de serie ni dirección una vez echo esto marcar la fila "6" con 1 para saber que tengo el dato en "bd_2"
1 respuesta
Te anexo la macro
Sub Comparativo()
'Por.Dante Amor
Set h1 = Sheets("inventario")
Set h2 = Sheets("bd_2")
'
For i = 2 To h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row
Set b = h1.Columns("C").Find(h2.Cells(i, "E"), lookat:=xlWhole) 'busca serie
If b Is Nothing Then
Set c = h1.Columns("D").Find(h2.Cells(i, "L"), lookat:=xlWhole) 'busca dirección
If c Is Nothing Then
u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 1
h1.Cells(u, "A") = h2.Cells(i, 7)
h1.Cells(u, "B") = h2.Cells(i, 8)
h1.Cells(u, "C") = h2.Cells(i, 5)
h1.Cells(u, "D") = h2.Cells(i, 12)
h1.Cells(u, "F") = 1
End If
End If
Next
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
