Copiar datos de una hoja a otra Excel
Comunidad de TE, quisiera que me ayuden con este código que me facilito "Dante":
Sub CopiaFlag()
Application.ScreenUpdating = False
Set h1 = Sheets("Autor_MASTER")
Set h2 = Sheets("Reportes")
h2.UsedRange.Offset(4, 0).ClearContents
j = 4
n = 0
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
'*********AQUI ES DONDE EN VEZ DE DATE PONGO 1 QUE SERIA EL ACTIVO DE UN REGISTRO
If h1.Cells(i, "AI") = Date Then
h1.Range("D" & i & ",H" & i & ",K" & i & ",L" & i & "," & _
"M" & i & ",N" & i & ":O" & i & ",P" & i).Copy
h2.Cells(j, "C").PasteSpecial xlValues
j = j + 1
n = n + 1
End If
Next
'Application.ScreenUpdating = True
Application.CutCopyMode = False
Call AutoAjustarColumns
MsgBox n & " Registro(s) copiado(s)", vbInformation, "Mensaje"
h1.Select
End SubBueno el caso es que este codigo permite copiar ciertas columnas de una hoja a otra, con la condicion que tenga una columna en especifico, es decir si la columna "AI"= Date entonces copia las filas detalladas a la hoja 2, me funciona a la perfeccion, el caso es que quiero usar el mismo metodo con otra condicion (por ejemplo "1") pero demora una eternidad en copiar, cosa que no sucede con la condicion Date que copia los datos rapidamente, la consulta es como puedo hacer para que los datos me copien de forma agil para no esperar demasiado tiempo (estamos tratando de unos 4000 registros a mas).
1 respuesta
Una opción es quitar el copy y poner el igual
Sub CopiaFlag()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Autor_MASTER")
Set h2 = Sheets("Reportes")
h2.UsedRange.Offset(4, 0).ClearContents
j = 4
'n = 0
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "AI") = 1 Then
h2.Cells(j, "C") = h1.Range("D" & i)
h2.Cells(j, "D") = h1.Range("H" & i)
h2.Cells(j, "E") = h1.Range("K" & i)
h2.Cells(j, "F") = h1.Range("L" & i)
h2.Cells(j, "G") = h1.Range("M" & i)
h2.Cells(j, "H") = h1.Range("N" & i)
h2.Cells(j, "I") = h1.Range("O" & i)
h2.Cells(j, "J") = h1.Range("P" & i)
'h1.Range("D" & i & ",H" & i & ",K" & i & ",L" & i & "," & _
"M" & i & ",N" & i & ":O" & i & ",P" & i).Copy
'h2.Cells(j, "C").PasteSpecial xlValues
j = j + 1
'n = n + 1
End If
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
Call AutoAjustarColumns
MsgBox j - 4 & " Registro(s) copiado(s)", vbInformation, "Mensaje"
h1.Select
End SubRealicé la prueba con 5 mil registros y se tardó 15 segundos.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Tengo 3607 registros, ya han pasado 13:51 y solo copiaron 3133 registros ='(
XD
Aun tarda demasiado, ¿a qué se deberá? Trabajo en office 2013
Con una Dell i7 Optiplex 9020 de 8GB de RAM. Dudo mucho que sea la pc.
=)
Puede ser que el procesador no esté diseñado para utilizar excel.
Puede ser el tamaño de tu archivo.
Puede ser que tengas demasiadas fórmulas.
Puede ser que tengas demasiadas hojas.
Puede ser que tengas fórmulas matriciales.
Puede ser que tu archivo o tu hoja estén dañadas.
Yo hice una prueba con esa macro para 5 mil registros y se tardó 15 segundos.
Realiza la prueba en otra computadora.
Realiza la prueba en tu computadora, pero en un archivo nuevo, utiliza solamente 2 hojas. Solamente llena la columna AI con algunos unos, para que verifiques la macro.
Sin duda la macro no es el problema, pero tienes que probarla de manera independiente en otro archivo.
¡Gracias! Tienes razón, debe ser por las fórmulas o algún otro factor, pero si funciona a la perfección, veré como lo implemento para que funcione en la hoja principal que manejo...
Saludos.
