macro buscar duplicados en hoja1 y copiarlos en hoja2

josebacoldo escribió el 07/04/2013 12:26 :

¡ Hola !
buenas, y gracias por adelantado: utilizo el excel 2003 y 2007
tengo una hoja en la que hay que buscar :
1- las filas que las columnas C,D,E juntas que coincidan con cualquier fila de
la hoja1, copie la fila original entera y las que se repitan, en la hoja2,cada
fila termina en la columna N
2- las filas de las columnas F,G,H igual que en la opcion 1, pero en esta no
tiene que detectar como repetido si las celdas estan en vacias.
la hoja1 llena de datos alcanza unas 50000 lineas, tengo una macro echa pero me
da error desbordamiento, agradeceria una ayuda, ya que me es urgente que
funcione.

en esta ruta que podeis descargar, esta el libro rellenado con 36000 lineas y
el macro que tengo echo el cual solo me funciona si la cantidad de lineas no
sobrepasa las 20000, pero necesito que se rellene con 50000. y funcione, muchas
gracias y espero alguna ayuda de alguien. os dejo el link de la descarga del
libro y mi correo por si quereis comunicarme algo mas rápido. ante todo
muchas gracias a todo el que se preste . Josebacoldo

https://mega.co.nz/#!JgVT0A4B!BqgUAz...wczrQDKE42CVxU

mi mail:

gracias, es de suma importancia.saludos.

el codigo que tengo yo del macro es este:
Option Explicit
Option Base 1
--------------------------------------------------
Sub duplicados()

Dim mD, d, e, mS(), s
Sheets("DUPLICADOS").Range("A:IV").ClearContents

mD = Range("A4").CurrentRegion
ReDim Preserve mD(UBound(mD, 1), UBound(mD, 2) + 3)

For d = 1 To UBound(mD, 1)
mD(d, 17) = Trim(mD(d, 3)) & Trim(mD(d, 4)) & Trim(mD(d, 5))
mD(d, 18) = Trim(mD(d, 6)) & Trim(mD(d, 7)) & Trim(mD(d, 8 ))
mD(d, 19) = "N"
Next

mD(1, 19) = "S"
mD(2, 19) = "S"
mD(3, 19) = "S"

For d = 4 To UBound(mD, 1)
For e = d + 1 To UBound(mD, 1)
If mD(d, 19) <> "S" Then
If mD(d, 17) = mD(e, 17) Or mD(d, 18) = mD(e, 18) Then
mD(d, 19) = "S"
mD(e, 19) = "S"
End If
End If
Next
Next

d = 0: e = 0
ReDim mS(UBound(mD, 1), UBound(mD, 2) - 3)
For d = 1 To UBound(mD, 1)
If mD(d, 19) = "S" Then
e = e + 1
For s = 1 To UBound(mD, 2) - 3
mS(e, s) = mD(d, s)
Next
End If
Next

Sheets("DUPLICADOS").Range("A1:P" & e) = mS

End Sub

pero me da error de desbordamiento en la linea

mD = Range("A4").CurrentRegion

cuando tengo la hoja rellena con 36000 lineas

me acepta hasta 20000 a veces

https://mega.co.nz/#!JgVT0A4B!BqgUAzRTB ... QDKE42CVxU

en este enlace tengo un ejemplo completo del problema