Notifications
Clear all

Excel para de funcionar

1 Posts
1 Usuários
0 Reactions
1,081 Visualizações
(@jokerpot)
Posts: 132
Estimable Member
Topic starter
 

Pessoal Bom Dia!

Tenho uma macro que consolida 2 arquivos em 1 (colunas distintas) e no final ela salva e fecha esse arquivo criado.

O codigo é o abaixo.

O problema que esta ocorrendo é que sempre no final do processo o excel trava e da erro inesperado e fecha (nao finaliza).

Alguem consegue me dizer o que pode estar ocorrendo e se há como deixar esse codigo mais enxuto??

Alem do codigo deixei a planilha base em anexo.

 

Sub Consolida()

TEMPO_INI = Time

n_caminho = Sheets("Parametros").Range("B3").Value
n_arquivo_gr = Sheets("Parametros").Range("B4").Value
n_arquivo_fs = Sheets("Parametros").Range("B5").Value
s_salva = Sheets("Parametros").Range("B6").Value

Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
Application.EnableEvents = False

fs_1 = Sheets("Parametros").Range("e3").Value
pr_1 = Sheets("Parametros").Range("e4").Value

a_nome = ActiveWorkbook.Name

Workbooks.Add
x_nome = ActiveWorkbook.Name
x_aba = ActiveSheet.Name

Workbooks.Open (n_caminho & "\" & n_arquivo_gr)

n_aba = ActiveSheet.Name
u_lin = Sheets(n_aba).Range("A1048576").End(xlUp).Row
u_col = Cells(5, Cells.Columns.Count).End(xlToLeft).Column

x_range = "A1" & ":" & "T" & u_lin
'Range(x_range).Select
Range(x_range).Copy

Windows(x_nome).Activate

Range("A1").Select
ActiveSheet.Paste

u_lin = Sheets(x_aba).Range("A1048576").End(xlUp).Row
u_lin = u_lin + 1

Windows(n_arquivo_gr).Close

Workbooks.Open (n_caminho & "\" & n_arquivo_fs)
y_aba = ActiveSheet.Name

y_lin = Sheets(y_aba).Range("A1048576").End(xlUp).Row - 1

y_range = fs_1 & ":" & fs_1 & y_lin
Range(y_range).Copy

Windows(x_nome).Activate

Range(pr_1 & u_lin).Select
ActiveSheet.Paste

For n_imp = 3 To 7
Windows(a_nome).Activate
bs_1 = Sheets("Parametros").Cells(n_imp, 13).Value
pr_1 = Sheets("Parametros").Cells(n_imp, 14).Value
ms_1 = Sheets("Parametros").Cells(n_imp, 15).Value

Windows(n_arquivo_fs).Activate
y_range = bs_1 & ":" & ms_1 & y_lin
Range(y_range).Copy
Windows(x_nome).Activate
Range(pr_1 & u_lin).Select
ActiveSheet.Paste
Next

Windows(n_arquivo_fs).Close

Windows(x_nome).Activate
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select

ActiveWorkbook.SaveAs Filename:= _
n_caminho & "\" & s_salva

Windows(s_salva).Close

Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

TEMPO_FIM = Time
Total = TEMPO_FIM - TEMPO_INI
MsgBox "ROTINA FINALIZADA EM: " & Format(Total, "hh:mm:ss"), vbInformation, "FIM"

End Sub

Editado pela Moderação. Motivo: Procure utilizar o botão Código (< >) sempre que for inserir código VBA ou Fórmulas.

 
Postado : 15/01/2021 10:57 am