Clear many empty tables of data

If my code okay, you can remove line 112 "rem" for hidden column "B"

Sub zz()
Application.ScreenUpdating = 0
If Sheets(1).[a1048576].End(3).Row = 6 Then Exit Sub
Dim ar As Variant, br(), zc&, zr&, n&, i&, ii&, j&, k&, h%, MyCell As Range, t As Variant, f$
Dim rng As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng6 As Range, rng7 As Range
Dim w(6), wc(1), rc(), a(), b(1 To 5)
rc = Array(0, 2, 3, 6)
ar = [a28:ao28].FormulaR1C1
For Each t In ar
    f = f & Chr(2) & t
Next
w(0) = Split(Mid(f, 2), Chr(2)): w(0)(0) = "Total"
w(2) = Array("Signing", "Signing", "Signing", "Signing", "Signing")
w(3) = Array("Competent", "Head of accounts", "Head of personnel affairs", "Financial Director", "General Director")
w(6) = w(0): w(6)(0) = "Total of above"
For i = 2 To UBound(w(0))
    If Len(w(0)(i)) Then w(6)(i) = "=r[-6]c"
Next
With Sheets(1)
    zr = .[a1048576].End(3).Row
    ar = .[a8].CurrentRegion.FormulaR1C1
    zc = UBound(ar, 2)
End With
ReDim a(1 To zc + 1)
i = IIf((zr - 7) Mod 20, Int((zr - 7) / 20) + 1, Int((zr - 7) / 20))
ReDim br(1 To i * 27 + UBound(w) + 1, 1 To zc + 1)
i = Int(UBound(br, 2) / 5)
With Sheets(2)
    f = 1 & Chr(2) & 2
    .ResetAllPageBreaks
    For i = 3 To zc + 1
    f = f & Chr(2) & i
        a(i) = .Columns(i).ColumnWidth / 2 + j: j = j + .Columns(i).ColumnWidth
    Next
    b(1) = 3: j = j - a(3) * 2 - .Columns(i - 1).ColumnWidth / 2
    For i = 2 To 5
        b(i) = Application.Match(j / 4 * (i - 1) + a(3), a, 1)
    Next
    wc(0) = Split(f, Chr(2))
    wc(1) = Array(3, b(2), b(3), b(4), b(5))
    If .[a1048576].End(3).Row > 34 Then .Rows("35:" & .[a1048576].End(3).Row).Delete Else .Rows(28).Copy .Rows(34)
    If .[xfd7].End(1).Column > zc + 1 Then .Range(.Cells(1, zc + 2), .Cells(1, .[xfd7].End(1).Column)).EntireColumn.Delete
    Set MyCell = ActiveCell
    For i = 3 To UBound(ar)
        n = n + 1
        br(n, 1) = i - 2
        For j = 1 To UBound(ar, 2)
            br(n, j + 1) = ar(i, j)
        Next
        If (i - 2) Mod 20 = 0 Then
            For ii = 0 To UBound(rc)
                h = IIf(rc(ii) Mod 6, 1, 0)
                For j = 0 To UBound(wc(h))
                    br(rc(ii) + n + 1, wc(h)(j)) = w(rc(ii))(j)
                Next
            Next
            k = (i - 2) / 20 * 27
            .HPageBreaks.Add .Rows(k + 7)
            If rng Is Nothing Then
                Set rng = .Cells(k - 19, 1).Resize(20, zc + 1)
                Set rng2 = .Cells(k + 1, 1).Resize(7, zc + 1)
                Set rng3 = Union(.Range(.Cells(k + 1, 1), .Cells(k + 1, 3)), .Range(.Cells(k + 7, 1), .Cells(k + 7, 3)))
                Set rng4 = .Range(.Cells(k + 5, b(5)), .Cells(k + 6, b(5) + 4))
                Set rng6 = .Range(.Cells(k + 5, b(5) - 1), .Cells(k + 5, 1))
                Set rng7 = .Range(.Cells(k + 2, 1), .Cells(k + 6, zc + 1))
            Else
                Set rng = Union(rng, .Cells(k - 19, 1).Resize(20, zc + 1))
                Set rng2 = Union(rng2, .Cells(k + 1, 1).Resize(7, zc + 1))
                Set rng3 = Union(rng3, Union(.Range(.Cells(k + 1, 1), .Cells(k + 1, 3)), .Range(.Cells(k + 7, 1), .Cells(k + 7, 3))))
                Set rng4 = Union(rng4, .Range(.Cells(k + 5, b(5)), .Cells(k + 6, b(5) + 4)))
                Set rng6 = Union(rng6, .Range(.Cells(k + 5, b(5) - 1), .Cells(k + 5, 1)))
                Set rng7 = Union(rng7, .Range(.Cells(k + 2, 1), .Cells(k + 6, zc + 1)))
            End If
            n = n + 7
        End If
    Next
    If n < 22 Then GoSub less
    If n > k Then
        n = UBound(br) - 6: k = n - 6: i = n - 20
        Set rng = Union(rng, .Cells(i, 1).Resize(20, zc + 1))
        Set rng2 = Union(rng2, .Cells(n, 1).Resize(7, zc + 1))
        Set rng3 = Union(rng3, Union(.Range(.Cells(n, 1), .Cells(n, 3)), .Range(.Cells(n + 6, 1), .Cells(n + 6, 3))))
        Set rng4 = Union(rng4, .Range(.Cells(n + 4, b(5)), .Cells(n + 5, b(5) + 4)))
        Set rng6 = Union(rng6, .Range(.Cells(n + 4, b(5) - 1), .Cells(n + 4, 1)))
        Set rng7 = Union(rng7, .Range(.Cells(n + 1, 1), .Cells(n + 5, zc + 1)))
        For ii = 0 To UBound(rc)
            h = IIf(rc(ii) Mod 6, 1, 0)
            For j = 0 To UBound(wc(h))
                br(rc(ii) + n - 7, wc(h)(j)) = w(rc(ii))(j)
            Next
        Next
    End If
    .[a8].Resize(UBound(br), UBound(br, 2)) = br
    .[a8].Resize(1, zc + 1).Copy: rng.PasteSpecial Paste:=xlPasteFormats
    .[a28].Resize(7, zc + 1).Copy: rng2.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = 0
    rng.EntireRow.RowHeight = .Rows(8).RowHeight
    Union(rng3, rng7).Font.Size = 24
    Union(rng3, rng7).Font.Bold = 1
    rng7.HorizontalAlignment = xlCenter
    rng3.EntireRow.RowHeight = 60: rng3.MergeCells = True
    For i = 7 To 10
    Next
    .Rows(.[a1048576].End(3).Row).Delete
    .PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(.[a1048576].End(3).Row, zc + 1)).Address
    .PageSetup.FitToPagesWide = 1
End With
MyCell.Select
Set rng = Nothing: Set rng2 = Nothing: Set MyCell = Nothing: Set rng3 = Nothing
Set rng4 = Nothing: Set rng6 = Nothing: Set rng7 = Nothing
Rem Call PRINT_ALL
Rem Columns(2).Hidden = True
Application.ScreenUpdating = 1
End
less:
With Sheets(2)
    Set rng = .Cells(8, 1).Resize(20, zc + 1)
    Set rng2 = .Cells(28, 1).Resize(7, zc + 1)
    Set rng3 = Union(.Cells(28, 1), .Cells(34, 1))
    Set rng4 = .Range(.Cells(32, b(5)), .Cells(33, b(5) + 4))
    Set rng6 = .Range(.Cells(32, b(5) - 1), .Cells(32, 1))
    Set rng7 = .Range(.Cells(29, 1), .Cells(33, zc + 1))
End With
Return
End Sub