Problem with Calculation Manual and with On Error?

[ljubo_gr]

Hello, dear MrExcel!

After running code and before that i checked that excel is set to Auto calculation, excel turns calculation to manual? Before code is Application.Calculation = xlCalculationManual and at end is Application.Calculation = xlCalculationAutomatic.
Also I have multiple On Error statements, maybe in there is error. Error is at line:

                                   Sheets("List3").Select
                                    Cells.Select
                                    On Error GoTo Skip
                                    ActiveSheet.ShowAllData
Skip:                                  Columns("D:D").Select

Full code:

Sub Macro1_ZAKLJUČAK_SMJENE()
'
' Macro1_ZAKLJUČAK_SMJENE Macro
'
'
Dim MSG As String, ANS As Variant
MSG = "  SIGURNO  ŽELITE  ZAKLJUČITI  SMJENU  I  OČISTITI  PODATKE ?"
ANS = MsgBox(MSG, vbExclamation + vbYesNo + vbDefaultButton2, "UPOZORENJE !!!")
Select Case ANS
Case vbYes
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
        On Error GoTo GRESKA2
                Sheets("List2").Select
                Cells.Select
                On Error GoTo nastavak1
                ActiveSheet.ShowAllData
nastavak1:       Columns("D:D").Select
                Dim R As Long
'Ovo kopira NAKNADNA PLAĆANJA na List2.
            If WorksheetFunction.CountA(Cells(4, 4).EntireColumn) > 10920 Then
                Rows("10921:10921").Select
                Range(Selection, Selection.End(xlDown)).Select
          yadayada
    yayayay
   yadayadayada
                Range("A2:A19").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.CutCopyMode = False
'             Ovo briše prazne ćelije iz List2 zavisno o stupcu D
                For R = Cells(Rows.Count, "D").End(xlUp).Row To 1 Step -1
                If Cells(R, "D") = "" Then Cells(R, "D").EntireRow.Delete xlUp
                Next R
                Sheets("List1").Select
            Else
         ydadyadayada
   yadaya
   yasda
   yadayadayada
                Range("A2:A19").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.CutCopyMode = False
                For R = Cells(Rows.Count, "D").End(xlUp).Row To 1 Step -1
                If Cells(R, "D") = "" Then Cells(R, "D").EntireRow.Delete xlUp
                Next R
                Sheets("List1").Select
            End If
                Sheets("List4").Select
                Rows("7:7").Select
                Dim Sh As Shape
                        If WorksheetFunction.CountA(Cells(7, 7).EntireRow) > 350 Then
                            Columns("ACP:ACP").Select
                  yada
    yada
    yadaya
                            For Each Sh In ActiveSheet.Shapes
                                Sh.Delete
                            Next Sh
                            Sheets(1).Activate
                        Else
               yada
     yada
     yada
                            Application.CutCopyMode = False
                            For Each Sh In ActiveSheet.Shapes
                                Sh.Delete
                            Next Sh
                            Sheets(1).Activate
                        End If
                                    Sheets("List3").Select
                                    Cells.Select
                                    On Error GoTo Skip
                                    ActiveSheet.ShowAllData
Skip:                                  Columns("D:D").Select
                                If WorksheetFunction.CountA(Cells(4, 4).EntireColumn) > 4200 Then
                                    Rows("4201:4201").Select
                              buch of copy-paste i dont know how to shorten code:(
                                    Application.CutCopyMode = False
                                    Sheets(1).Activate
                                Else
                                    Rows("2:10").Select
                                    
     buch of copy-paste i dont know how to shorten code:(
                                    Application.CutCopyMode = False
                                    Sheets(1).Activate
                                End If
GRESKA2:
 
            Range("H1:J2,I4:J5").Select
            Selection.ClearContents
   Here i know how to select multiple ranges and clear contents
            Range("G15:G23,A26:D43,I30:I35,E46:H48,B46:B48").Select
            Application.CutCopyMode = False
            Selection.ClearContents
            Range("G5").Select
            Selection.Copy
            Range("E5").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("G5").Activate
            Application.CutCopyMode = False
            Selection.ClearContents
            Range("E5").Value = Range("E5").Value + 1
            Application.CutCopyMode = False
            Range("H1:J1").Select
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
Case vbNo
GoTo QUIT:
         End Select
QUIT:
End Sub