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