CurrentRegion.SpecialCells(xlCellTypeVisible) слишком медленный — советы по повышению производительности?

Я пытаюсь автоматизировать отчет, который имеет 5 разных источников информации. Я пытаюсь сделать UNION разных таблиц в одну, используя ListObjects, все работает нормально, за исключением случаев, когда я копирую первый столбец первого ListObject. Копирование первого столбца занимает около 2 минут, следующие столбцы — менее 1 секунды.

Каждый раз, когда я запускаю сценарий VBA, я удаляю все строки целевой таблицы, чтобы запустить сценарий VBA с ListObject с 0 строками.

Попробую объяснить, как это работает:

Sub ProcesarPresupuesto() 
'This is the first macro that process and copy the information of the first source

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Application.Calculation = xlCalculationManual

'<Here> I add several columns and process the information of this first source, I keep all the rows as values using the Function: AddColumnFormula (at the end of this example). I think this is not causing the problem.

'Then I fill all the Blanks Cells to avoid having empty cells in my final table.
Sheets("Origin").Select
Selection.CurrentRegion.Select
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "Null"
On Error GoTo 0

'When I have the ListObject ready I start copying the columns to the destination

Sheets("Destination").Select
Range("A1").Select
While ActiveCell.Value <> ""
Call CopyColumn("Origin", ActiveCell.Value, "Destination")
ActiveCell.Offset(0, 1).Select
Wend

End Sub

Я думаю, это должно быть очень быстро. Если я удаляю только значения Destination ListObject и оставляю строки пустыми, первый столбец копируется немедленно, поэтому я думаю, что проблема связана с тем, как Excel вычисляет первые строки, добавляемые в ListObject. Есть ли лучший способ скопировать столбец, когда таблица пуста? Я делаю что-то действительно неправильно?

Это функция CopyColumn

Function CopyColumn(Origin, ColumnName, Destination)
    Range(Origin & "[[" & ColumnName & "]]").Copy Destination:=Range(Destination & "[[" & ColumnName & "]]")
End Function

Это функция, которую я использую для обработки столбцов

Function AddColumnFormula(DestinationSheet, TableName, ColumnName, Value)

Set NewColumn = Sheets(DestinationSheet).ListObjects(TableName).ListColumns.Add
NewColumn.Name = ColumnName

Set Rango = Range(TableName & "[[" & ColumnName & "]]")
Rango.Value = Value
Rango.Copy
Rango.PasteSpecial (xlPasteValues)

End Function

Заранее спасибо за ваше время и ответы