Comparar 2 hojas y sacar una tercera

DAN tengo el siguiente caso:

En un mismo archivo 3 hojas: Inventario, toma-física, sobrantes-faltante. Debo comparar la columna A de inventario con la columna A de toma-física y colocar lo que este en Inventario que no este en toma-física en la columna A de sobrantes-faltante. Y luego comparar la A de toma física con la A de inventario y lo que este en tomafisica que no este en inventario colocarlo en la columna C de sobrante-faltante. Todos los rangos deben empezar en la fila 8.

Tengo esta macro que funciona perfectamente pero si todos están en la misma hoja, es decir compara A con B y coloca faltantes en C y sobrante en D, pero en diferentes hojas no, y no se como arreglarla .

Private Sub CommandButton1_Click()
Dim celda, valor As String
Range("A2").Select
Do While ActiveCell.Value <> ""
celda = ActiveCell.Address
valor = ActiveCell.Value
Range("B2").Select
Do While ActiveCell.Value <> ""
If ActiveCell.Value = valor Then
Exit Do
Range(celda).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
If ActiveCell.Value = "" Then
Range("C2").Select
Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = valor
End If
Range(celda).Select
ActiveCell.Offset(1, 0).Select
valor = ActiveCell.Value
Loop
Range("B2").Select
Do While ActiveCell.Value <> ""
celda = ActiveCell.Address
valor = ActiveCell.Value
Range("A2").Select
Do While ActiveCell.Value <> ""
If ActiveCell.Value = valor Then
Exit Do
Range(celda).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
If ActiveCell.Value = "" Then
Range("d2").Select
Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = valor
End If
Range(celda).Select
ActiveCell.Offset(1, 0).Select
valor = ActiveCell.Value
Loop
End Sub

2

2 Respuestas

3.726.100 pts. Si me amas, siempre voy a estar en tu corazón; si me...

Esta sería la macro

Sub inventario()
'Por.DAM
Set h1 = Sheets("Inventario")
Set h2 = Sheets("toma-física")
Set h3 = Sheets("sobrantes-faltante")
h3.Cells.Clear
j = 8
For i = 8 To h1.Range("A" & Rows.Count).End(xlUp).Row
    Set b = h2.Range("A:A").Find(h1.Cells(i, "A"))
    If b Is Nothing Then 'no lo encontró
        h1.Cells(i, "A").Copy h3.Cells(j, "A")
        j = j + 1
    End If
Next
j = 8
For i = 8 To h2.Range("A" & Rows.Count).End(xlUp).Row
    Set b = h1.Range("A:A").Find(h2.Cells(i, "A"))
    If b Is Nothing Then 'no lo encontró
        h2.Cells(i, "A").Copy h3.Cells(j, "C")
        j = j + 1
    End If
Next
End Sub

Saludos.Dante Amor

156.750 pts. mas por viejo que por Diablo No soy doctor en medicina,...

Luego voy a revisar la macro,

Pero no veo porque no usas fórmulas comunes en lugar de macros

Como por ejemplo,

En la columna A de sobrante-faltante puedes poner:

=SI( ESERROR(BUSCARV(Inventario!A9;'toma-física'!A9:A33; 1; 0));Inventario!A9;"")

Y

En la columna C de sobrante-faltante puedes poner:

=SI( ESERROR(BUSCARV('toma-física'!A9;Inventario!A8:A33; 1; 0));'toma-física'!A9;"")

Ok muchas ¡Gracias! 

¿Reviso la macro?

o

¿Vas a usar esas fórmulas?

Voy a usar la macro,

gracias

No logro desenrredar tu macro

Así que hice una más simple

Sub CommandButton1_Click()
Sheets("Inventario").Select
ActiveCell.SpecialCells(xlLastCell).Select
maxi = ActiveCell.Row
Sheets("toma-física").Select
ActiveCell.SpecialCells(xlLastCell).Select
maxt = ActiveCell.Row

Sheets("sobrantes-faltante").Select
Range("A7").Select
ActiveCell.FormulaR1C1 = "No esta en TomaFisica"
Range("C7").Select
ActiveCell.FormulaR1C1 = "No esta en Inventario"
Range("A8").Select
ActiveCell.FormulaR1C1 = _
"=IF( ISERROR(VLOOKUP(Inventario!RC,'toma-física'!R8C1:R" & maxt & "C1, 1, 0)),Inventario!RC,"""")"
Range("C8").Select
ActiveCell.FormulaR1C1 = _
"=IF( ISERROR(VLOOKUP('toma-física'!RC[-2],Inventario!R8C1:R" & maxi & "C1, 1, 0)),'toma-física'!RC[-2],"""")"
Range("A8:A" & maxi).FillDown
Range("C8:C" & maxt).FillDown
Max = maxi
If maxi < maxt Then Max = maxt
Range("A8:C" & Max).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas