Já aconteceu de você ter uma planilha de uns 5 ou 6 MB, a qual você efetuar algumas atualizações, talvez criando alguns gráficos, e algumas tabelas dinâmicas, vê essa planilha aumentar de tamanho de 3 a 100 vezes! Ficou surpreso? Sim porque é possível, então não se preocupe demais, vou ajudá-lo.
Bem, em primeiro lugar precisamos entender a diferença entre Excel Default Last Cell e Actual Last Cell. Quando pressionamos Ctrl + End para encontrar a última célula (Actual Last Cell), nós chegamos a Excel Default Last Cell, que pode ser a Actual Last Cell ou podem ser células vazias que ficam muito além desta. Quanto mais distante da Excel Default Last Cell estiver a Actual Last Cell mais espaço desnecessário está sendo ocupado na planilha atual.
Qual a solução? Apague todas as linhas e colunas além do Actual Last Cell em cada planilha. Se houver demasiadas planilhas e grandes conjuntos de dados, poderá usar o código VBA a seguir:
Dim CSheet As String 'New Worksheet
Dim OSheet As String 'Old WorkSheet
Dim ECol As Long 'Last Column
Dim BRow As Long 'Last Row
For Each WSheet In Worksheets
'Put the sheets in a variable to make it easy to go back and forth
'Rename the sheet to its name with _Delete at the end
OSheet = CSheet & "_Delete"
'Add a new sheet and call it the original sheets name
ActiveSheet.Name = CSheet
'Find the bottom cell of data on each column and find the further row
For Col = 1 To Columns.Count 'Find the actual last bottom row
If Cells(Rows.Count, Col).End(xlUp).Row > BRow Then
BRow = Cells(Rows.Count, Col).End(xlUp).Row
'Find the end cell of data on each row that has data and find the furthest one
For lRow = 1 To BRow 'Find the actual last right column
If Cells(lRow, Columns.Count).End(xlToLeft).Column > ECol Then
ECol = Cells(lRow, Columns.Count).End(xlToLeft).Column
'Copy the REAL set of data
Range(Cells(1, 1), Cells(BRow, ECol)).Copy
Range("A1").PasteSpecial xlPasteAll
Range("A1").PasteSpecial xlPasteColumnWidths
For Each Pic In ActiveSheet.Pictures
Sheets(CSheet).Pictures(Pic.Index).Top = Pic.Top
Sheets(CSheet).Pictures(Pic.Index).Left = Pic.Left
'Reset the variable for the next sheet
' Since, Excel will automatically replace the sheet references for you on your formulas,
' the below part puts them back.
' This is done with a simple replace, replacing _Delete with nothing
For Each WSheet In Worksheets
Cells.Replace "_Delete", ""
'Roll through the sheets and delete the original fat sheets
For Each WSheet In Worksheets
If Not Len(Replace(WSheet.Name, "_Delete", "")) = Len(WSheet.Name) Then
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Tags: Bernardes, MS, Microsoft, Office, VBA, Sheet, woksheet, shrink, diminuir, reduce, compact, size, file, planilha, arquivo
André Luiz Bernardes
A&A® - Work smart, not hard. Skype: inanyplace