Macro para Copiar datos de la Hoja1 a la Hoja2 sin duplicados
Estimados muy buenas noches primeramente felicitarles por los aportes ya que nos enseñan mucho a las los que estamos iniciando en el mundo del VBA.
Tengo un problema como puedo realizar lo siguiente creando una macro,
1.- Hoja1 es una base de Datos que contiene los items de todos los productos que se maneja.
Columna A: MARCA, columna B: Item, columna C: costo.
2.-Hoja2 tengo los mismos items en donde comparo precios etc.
Columna A: MARCA, columna B: Item, columna C: costo.
Ahora el problema es:
Ya que la en la Hoja1 "base" se actualiza constantemente y se ingresan items nuevos necesito copiar solo los items nuevos a la Hoja2 sin que se repitan.
1 Respuesta
Esta macro lee los datos de la columna A de la hoja 1 y compara las marcas con las marcas presentes en la hoja2 si están presentes no hace nada si no están entonces ira copiando las filas una debajo de otra
Sub COPIAR_UNICOS()
Set ORIGEN = Sheets("HOJA1").Range("A1").CurrentRegion
Set DESTINO = Sheets("HOJA2").Range("A1").CurrentRegion
With ORIGEN
FILAS = .Rows.Count
For I = 1 To FILAS
MARCA = .Cells(I, 1)
CUENTA = WorksheetFunction.CountIf(DESTINO.Columns(1), MARCA)
If CUENTA = 0 Then
FILAS2 = DESTINO.CurrentRegion.Rows.Count
DESTINO.Rows(FILAS2 + 1).Value = .Rows(I).Value
End If
Next I
End With
Set ORIGEN = Nothing: Set DESTINO = Nothing
End Sub
Muchas gracias funciona..
Pero como lo adapto para que solamente se copie a la hoja2 solo las tres primeras columnas antes mecionadas, ya que existen varias columnas que coinciden también en la Hoja1 y Hoja2,
Por favor gracias.
Esta es la modificación de la macro ahora solo copia las filas de las 3 primeras columnas
Sub COPIAR_UNICOS()
Set ORIGEN = Sheets("HOJA1").Range("A1").CurrentRegion
Set DESTINO = Sheets("HOJA2").Range("A1").CurrentRegion
With ORIGEN
FILAS = .Rows.Count
For i = 1 To FILAS
MARCA = .Cells(i, 1)
CUENTA = WorksheetFunction.CountIf(DESTINO.Columns(1), MARCA)
If CUENTA = 0 Then
FILAS2 = DESTINO.CurrentRegion.Rows.Count
DESTINO.Cells(FILAS2 + 1, 1).Resize(1, 3).Value = .Cells(i, 1).Resize(1, 3).Value
End If
Next i
End With
Set ORIGEN = Nothing: Set DESTINO = Nothing
End Sub
