Copiar y cortar datos por color de fondo

Que tal fjulianes tengo una duda:
Revise la macro que me diste y le hice algunas modificaciones y quedo así:
Sub CopiarPorColorFondo()
Dim c As Range
Dim lin1 As Integer
lin1 = 1
Range("A1").Select
Selection.CurrentRegion.Select
For Each c In Range("A:A")
If c.INTERIOR.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Sheet2").Cells(lin1, 1)
lin1 = lin1 + 1
End If
Next
End Sub
Lo único que veo es que es muy lenta que puedo hacer.

1 Respuesta

Respuesta
1
Estas usando:
For each c in range("a:a")
Que selecciona toda la columna A (65536 filas). Esa es la causa de la lentitud.
Agregá la linea :
selection.resize(selection.rows.count,1).select
despues de :
selection.currentregion.select
Esto hace que tome las filas de la primer columna , del rango con datos.
y reemplazá :
For each c in range("a:a")
por
For each c in selection
Creo que con esto se soluciona el problema del tiempo.
Cuidado, que estás recorriendo solo la primer columna de un rango . Yo creía que la celda de color podía estar en cualquier columna . En ese caso no hace falta la linea insertada y solo es necesario el segundo reemplazo (selection por rango("a:a")).
Espero haber resuelto tu problema. Suerte.
Y si en dado caso tengo lineas en blanco y luego tengo más linea de color rojo el selection las ingnora y solo toma en cuenta la ultima linea donde encontró datos bueno tu me entiendes no.
Por eso es que estaba usando el range y no el selection.
Hay alguna forma de evitar esto.
Muchas gracias.
En lugar de selection.currentregion.select
ingresá :
Range("a1", ActiveCell.SpecialCells(xlLastCell).Offset(1, 0).End(xlToLeft).End(xlUp)).Select
y en el For each usá selection.
Espero haber dado en el clavo esta vez. Suerte.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas