Excel VBA ScreenUpdating не получает ЛОЖЬ - это всегда ИСТИНА - не может внести никаких изменений

Question

Очень похоже на этот вопрос Я испробовал все возможности, но даже сразу после строки Sub Macro1 (), Application.Screenupdating = False не меняет его на False, оно всегда выглядит как True.

В чем причина? До этого макроса не было другого макроса и т. Д. Поэтому я совершенно не представляю, почему он не меняется на выражение False?

Полный код:

Sub Macro1()

 With Application
 .ScreenUpdating = False
 .Calculation = xlCalculationManual
 .EnableEvents = False
 .DisplayStatusBar = False
 End With

Dim wsO As Worksheet, wsI As Worksheet
Set wsI = Sheet2
Set wsO = Sheet1
Dim RowLastB As Long, rowlastA As Long, FirstBcellRow As Long, FirstBcellText As String, OutputNewRowQty As Long, i As Long, x As Long, beginforB As Long

Call Module3.DeleteBlankRowsInp
Call Module3.DeleteBlankRowsOutp
Call Module3.DeleteBlankColumnsInp
Call Module3.DeleteBlankColumnsOutp

wsI.Activate
    wsI.UsedRange.Select
    With Selection
        .MergeCells = False
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlLTR
        .WrapText = False
        '.Columns.AutoFit
        .ColumnWidth = 12
        '.Rows.AutoFit
    End With
'    wsI.Range("C:C").ColumnWidth = 40
'    wsI.Range("B:B").ColumnWidth = 30

 wsO.Activate
    wsO.UsedRange.Select
    With Selection
        .MergeCells = False
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlLTR
        .WrapText = False
        '.Columns.AutoFit
        .ColumnWidth = 12
        .Rows.AutoFit
    End With
    wsO.Range("A:E").ColumnWidth = 8.5
    wsO.Range("M:O").ColumnWidth = 3.5
    wsO.Range("T:V").ColumnWidth = 3.5

RowLastB = wsI.Cells(Rows.Count, "B").End(xlUp).Row
rowlastC = wsI.Cells(Rows.Count, "C").End(xlUp).Row

'Insert 4 Columns to the left of Column W
wsO.Columns("X:AA").Insert Shift:=xlToRight, _
      CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
wsO.Range("X4") = "Last Done On Date"
wsO.Range("Y4") = "Reading"
wsO.Range("Z4") = "Next Due Date at Date"
wsO.Range("AA4") = "Reading"

'Fill all empty cells in column F to apply filter
Maxrow = Range("F" & Rows.Count).End(xlUp).Row

On Error Resume Next
Range("F1:F" & Maxrow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "."

beginforB = 1

For i = beginforB To RowLastB
'wsI.Activate
FirstBcellRow = wsI.Range("B" & i).End(xlDown).Row
FirstBcellText = wsI.Range("B" & i).End(xlDown).Text
On Error GoTo Below

wsO.Range("F:F").AutoFilter field:=1, Criteria1:=FirstBcellText

i = FirstBcellRow
If i = RowLastB Then
OutputNewRowQty = (rowlastC - RowLastB)

For j = 1 To (OutputNewRowQty)
policyNoInOutp = wsO.Range("G:G").Find((wsI.Range("C" & FirstBcellRow + j).Text), , xlValues, xlWhole).Row
wsI.Range("H" & FirstBcellRow + j).Copy
wsO.Range("x" & policyNoInOutp).PasteSpecial xlPasteAll
wsI.Range("K" & FirstBcellRow + j).Copy
wsO.Range("Y" & policyNoInOutp).PasteSpecial xlPasteAll
wsI.Range("M" & FirstBcellRow + j).Copy
wsO.Range("z" & policyNoInOutp).PasteSpecial xlPasteAll
wsI.Range("P" & FirstBcellRow + j).Copy
wsO.Range("aa" & policyNoInOutp).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Next

Exit For
Else
SecondBcellRow = wsI.Range("B" & i).End(xlDown).Row
OutputNewRowQty = (SecondBcellRow - FirstBcellRow) - 1
'We have that amount of sub-header under each main header

For j = 1 To (OutputNewRowQty)

policyNoInOutp = wsO.Range("G:G").Find((wsI.Range("C" & FirstBcellRow + j).Text), , xlValues, xlWhole).Row

wsI.Range("H" & FirstBcellRow + j).Copy
wsO.Range("x" & policyNoInOutp).PasteSpecial xlPasteAll
wsI.Range("K" & FirstBcellRow + j).Copy
wsO.Range("Y" & policyNoInOutp).PasteSpecial xlPasteAll
wsI.Range("M" & FirstBcellRow + j).Copy
wsO.Range("z" & policyNoInOutp).PasteSpecial xlPasteAll
wsI.Range("P" & FirstBcellRow + j).Copy
wsO.Range("aa" & policyNoInOutp).PasteSpecial xlPasteAll
Application.CutCopyMode = False

Next


'wsO.Activate
wsO.AutoFilter.ShowAllData
beginforB = FirstBcellRow
End If

Below:
On Error GoTo 0
Next
'wsO.Activate
wsO.AutoFilter.ShowAllData

 With Application
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
 .EnableEvents = True
 .DisplayStatusBar = True
 End With

End Sub

Я пытался добавить к каждомулиния, но просто без изменений. Что мне не хватает?