Copia de filas visibles / filtradas de manera eficiente en Excel

Estoy trabajando con algunos sets de datos muy grandes (varias hojas con 65K + filas y muchas columnas cada una). Intento escribir un código para copyr los datos filtrados de una hoja a una nueva hoja vacía lo más rápido posible, pero hasta ahora no he tenido mucho éxito.

Puedo include el rest del código por request, pero todo lo que hace es calcular los ranges de origen y destino (srcRange y destRange). El time necesario para calcular estos es insignificante. La gran mayoría del time se gasta en esta línea (4 minutos y 50 segundos para ser precisos):

srcRange.Rows.SpecialCells(xlCellTypeVisible).Copy Destination:=destRange 

Además, he intentado esto:

 destRange.Value = srcRange.Rows.SpecialCells(xlCellTypeVisible).Value 

Pero no funciona correctamente cuando hay un filter.

 Function FastCopy(srcSheet As String, srcCol As String, destSheet As String, destCol As String) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim srcRange As Range Dim destRange As Range Set srcRange = GetColumnRangeByHeaderName(srcSheet, srcCol, -1) Set destRange = GetColumnRangeByHeaderName(destSheet, destCol, srcRange.Rows.Count) 'destRange.Value = srcRange.Rows.SpecialCells(xlCellTypeVisible).Value srcRange.Rows.SpecialCells(xlCellTypeVisible).Copy Destination:=destRange Application.ScreenUpdating = True Application.Calculation = xlCalculationManual End Function 

Esta es una máquina lenta de doble núcleo con 2 GB de RAM funcionando con excelente desempeño en 2010. Los resultados variarán obviamente en una máquina más rápida.

Pruebe algo como esto para trabajar con ranges filtrados. Está en el path correcto, el método .Copy es costoso y simplemente escribir valores de un range a otro debería ser mucho más rápido, sin embargo, como observa, esto no funciona cuando se filtra un range. Cuando se filtra el range, necesita iterar las .Areas en las .Areas del range:

 Sub Test() Dim rng As Range Dim subRng As Range Dim destRng As Range Set destRng = Range("A10") Set rng = Range("A1:B8").SpecialCells(xlCellTypeVisible) For Each subRng In rng.Areas Set destRng = destRng.Resize(subRng.Rows.Count, subRng.Columns.Count) destRng.Value = subRng.Value Set destRng = destRng.Cells(destRng.Rows.Count, 1).Resize(1, 1).Offset(1, 0) Next End Sub 

Modificado para sus propósitos, pero no probado:

 Function FastCopy(srcSheet As String, srcCol As String, destSheet As String, destCol As String) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim srcRange As Range Dim destRange As Range Dim subRng As Range Set srcRange = GetColumnRangeByHeaderName(srcSheet, srcCol, -1) Set destRange = GetColumnRangeByHeaderName(destSheet, destCol, srcRange.Rows.Count) For Each subRng In srcRange.Areas Set destRng = destRng.Resize(subRng.Rows.Count, subRng.Columns.Count) destRng.Value = subRng.Value Set destRng = destRng.Cells(destRng.Rows.Count, 1).Resize(1, 1).Offset(1, 0) Next Application.ScreenUpdating = True Application.Calculation = xlCalculationManual End Function