estos cuando encuentra que son iguales copia la fila desde la columna B hasta la columna AK
y la pega todo ese rango apartir de la columna AY enfrente del dato repetido dela columna AV
Pueden ejecutar la macro para que vean lo que explico de como funciona
Mi solicitud esta en que si alguien me pueda ayudar a hacer algún arreglo a la macro para que funcione de manera mas rapida lo mas posible
ya que ejecutar tengo que ejecutar esta macro en tres hojas de datos y cada hoja con 800 mil registros
Por favor he leido en tutoriales que se pueden cambiar los "for"
Seguramente alguien me puede ayudar
Muchas Gracias este es el código y envio el archivo
Sub CopiarDatosIguales()
Dim b As Long, a As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For b = 2 To Range("AV2").End(xlDown).Row
Set a = Columns("A").Find(What:=Range("AV" & b).Value, LookAt:=xlWhole)
If Not a Is Nothing Then
If b Mod 500 = 0 Then Application.StatusBar = "Fila: " & b
Range(Range("AY" & b), Range("CH" & b)).Value = _
Range(Range("B" & a.Row), Range("AK" & a.Row)).Value
Range("A" & a.Row).Interior.ColorIndex = Int(Rnd * 55) + 1
Range("AV" & b).Interior.ColorIndex = False
End If
Next
Application.CutCopyMode = False
Application.StatusBar = "Listo"
MsgBox "Proceso completado"
End Sub
Biuenos dias les mando saludos a todos....
Esperando pueda alguien apoyarme..
envio un archivo con una macro que
compara los datos dela columna A con AV
estos cuando encuentra que son iguales copia la fila desde la columna B hasta la columna AK
y la pega todo ese rango apartir de la columna AY enfrente del dato repetido dela columna AV
Pueden ejecutar la macro para que vean lo que explico de como funciona
Mi solicitud esta en que si alguien me pueda ayudar a hacer algún arreglo a la macro para que funcione de manera mas rapida lo mas posible
ya que ejecutar tengo que ejecutar esta macro en tres hojas de datos y cada hoja con 800 mil registros
Por favor he leido en tutoriales que se pueden cambiar los "for"
Seguramente alguien me puede ayudar
Muchas Gracias este es el código y envio el archivo
Sub CopiarDatosIguales() Dim b As Long, a As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For b = 2 To Range("AV2").End(xlDown).Row Set a = Columns("A").Find(What:=Range("AV" & b).Value, LookAt:=xlWhole) If Not a Is Nothing Then If b Mod 500 = 0 Then Application.StatusBar = "Fila: " & b Range(Range("AY" & b), Range("CH" & b)).Value = _ Range(Range("B" & a.Row), Range("AK" & a.Row)).Value Range("A" & a.Row).Interior.ColorIndex = Int(Rnd * 55) + 1 Range("AV" & b).Interior.ColorIndex = False End If Next Application.CutCopyMode = False Application.StatusBar = "Listo" MsgBox "Proceso completado" End Sub
Libro29.xlsm