Problema com Macro Export
Enviado: 20 Fev 2017 às 13:31
Fala pessoal, beleza?
Fiz a junção de 8 planilhas em uma só e obviamente o arquivo ficou bem grande. Tentei salvar em xlsb, diminuiu o tamanho mas a planilha continuou muito pesada e como os computadores aqui do serviço são um bem antigos, levava 10/15 minutos para abrir. Conversando com um conhecido que entende um pouco mais do que eu, ele me deu a ideia de fazer uma Macro que exportasse uma cópia da planilha. Me explicou como fazer, e após um dia todo trabalhando nisso, consegui escrever o código, só que ele não compila de forma alguma, retorna um que há um erro onde aparentemente não há. Se alguém puder me ajudar eu ficarei muito grato.
Segue o código abaixo para facilitar a análise do problema:
Fiz a junção de 8 planilhas em uma só e obviamente o arquivo ficou bem grande. Tentei salvar em xlsb, diminuiu o tamanho mas a planilha continuou muito pesada e como os computadores aqui do serviço são um bem antigos, levava 10/15 minutos para abrir. Conversando com um conhecido que entende um pouco mais do que eu, ele me deu a ideia de fazer uma Macro que exportasse uma cópia da planilha. Me explicou como fazer, e após um dia todo trabalhando nisso, consegui escrever o código, só que ele não compila de forma alguma, retorna um que há um erro onde aparentemente não há. Se alguém puder me ajudar eu ficarei muito grato.
Segue o código abaixo para facilitar a análise do problema:
Código: Selecionar todos
Sub Exportar()
Sheets("PAINEL").Select
Application.ScreenUpdating = False
hora = Now() '
Caminho = ThisWorkbook.Path & "\"
Sheets(Array("Ranking", "Planificador NPP", "Super P", "Ranking SP", "OW", "Trad", "Ranking Trad", _
"Ranking Quali", "Planificador Quali", "Planificador Tudão")).Select
Sheets("PAINEL").Activate
Sheets(Array("Ranking", "Planificador NPP", "Super P", "Ranking SP", "OW", "Trad", "Ranking Trad", _
"Ranking Quali", "Planificador Quali", "Planificador Tudão")).Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
Application.CutCopyMode = False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("PAINEL").Select
Range("B8").Select
ActiveWorkbook.SaveAs Filename:= _
Caminho & "Painel Único.xls" _
, CreateBackup:=False
ActiveWindow.Close
MsgBox ("Exportado com Sucesso!!!" & Chr$(CharCode:=13) & "Tempo de Execução:" & " " & Format((hora - Now()), "hh:mm:ss"))
Sheets("PAINEL").Select
End Sub