Belan, não sei se teremos ganho de performance, mas pode tentar a rotina abaixo, a diferença da a que o colega Wagner indicou, é que na rotina dele estamos verificando linha a linha por colunas, e se for um a Vazio deletamos, e nesta rotina verificamos por Colunas e se na mesma temos qualquer celula em branco, sem efetuar comparações com as demais linhas, mas faça os testes e veja se a performance melhora.
Sub DeletarColunasCellsBlanks()
Dim UltimaColuna As Long
Dim xCol As Long
UltimaColuna = Sheets("Plan1").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
For xCol = UltimaColuna To 1 Step -1
With Columns(xCol)
On Error Resume Next
'Verifica se temos alguma celula em branco na coluna
CCount = .SpecialCells(xlCellTypeBlanks).Areas(1).Cells.Count
'Se positivo Deletamos a Coluna
If CCount <> 0 Then
.SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
End If
End With
CCount = Nothing
Next xCol
End Sub
Quanto a questão que citou de piscar a tela, podemos utilizar a instrução "Application.ScreenUpdating = False" para evitar a exibição das açoes enquanto a rotina é executada, ou seja, na rotina do Wagner, adicione esta instrução logo apos :
UltimaColuna = Sheets("Plan3").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
e no final da rotina apos o "Next i" adicione novamente, mas revertendo a propriedade para True, descongelando a tela.
Application.ScreenUpdating = True
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 04/11/2015 12:17 pm