Excel Excel não responde após executar a macro

[Vitor Durso]

A macro executa normalmente e dá pra ver que foi executado até a última linha, porém o excel trava e não volta a responder mesmo depois de muito tempo. 

Como trabalho em ambiente de rede via VPN, tentei trazer o arquivo pro HD do note, mas não funcionou. Também tentei executar após "zerar" a memória RAM e deu o mesmo problema.

As demais macros da planilha executam normalmente sem travar.

 

Me salvem por favor! Aprendi VBA sozinho vendo exemplos na internet e não conheço as melhores práticas...

 

Sub Macro1()

    Application.ScreenUpdating = False
    Workbooks.Open Filename:= _
        "Y:\xxxx\xxxxx\xxxxx\xxxx\YYYYY.xlsx" _
        , UpdateLinks:=0
    Sheets("ZZZZZ").Select
    For t = xRows To 1 Step -1
        If Application.WorksheetFunction.CountA(WorkRng.Rows(t)) = 0 Then
           WorkRng.Rows(t).EntireRow.Delete XlDeleteShiftDirection.xlShiftUp
        End If
    Next
    Range("B8:CZ3000").Select
    Selection.Copy
    Windows("Base.xlsm").Activate
    Sheets("ABCDE").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("C3").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.UnMerge
    
    Dim ultimalinha, r As Integer
    ultimalinha = ActiveSheet.UsedRange.Row - 1 + _
    ActiveSheet.UsedRange.Rows.Count
    
    For r = ultimalinha To 1 Step -1
    	If Application.CountA(Rows(r)) = 0 Then
    	Rows(r).Delete
    	End If
    Next r
    
    Range("B:C,E:H,K:AE,AG:BL").Select
    Range("AG1").Activate
    ActiveWindow.SmallScroll ToRight:=5
    Range("B:C,E:H,K:AE,AG:BL,BN:BQ").Select
    Range("BN1").Activate
    ActiveWindow.SmallScroll ToRight:=4
    Range("B:C,E:H,K:AE,AG:BL,BN:BQ,BS:CC,CE:CO,CQ:CW").Select
    Range("CQ1").Activate
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Série"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Modelo"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Versão"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "MVSOPT"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Custo"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "Descrição Arrumada"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-11],3)"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-12],4,3)"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(RC[-13],1)"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=RC[-3]&RC[-2]&RC[-1]&RC[-12]"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-7]<0,0,RC[-7])"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=TRIM(RC[-13])"
    Dim LastRow As Long
    With ActiveSheet
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("L2:q2").AutoFill .Range("L2:q2").Resize(LastRow)
    End With

    Columns("L:Q").Select
    Columns("L:Q").EntireColumn.AutoFit
    Range("Q2").Select
    
    Application.ScreenUpdating = True
    
End Sub

 

 

[Midori]

Sem o arquivo para testar fica mais difícil ajudar.

 

Essa macro sem modificação já rodou sem travar antes? Se sim pode ser algum problema com o arquivo, já tentou testar em outro?

 

Se a macro é ativada por algum evento como SelectionChange/Change, tente rodar manualmente.