Clear many empty tables of data

See is suitable for you or not?

Option Explicit

Private Sub Worksheet_Activate()
Application.ScreenUpdating = 0
Dim ar As Variant, br(), zc&, zr&, n&, i&, j&, k&, h%, MyCell As Range
Dim rng As Range, rng2 As Range, rng3 As Range, w()
w = Array("TOTAL", "Signatures(1)", "Signatures(2)", "Signatures(3)", "Signatures(4)", "Signatures(5)", "Total of the above")
With Sheets(1)
    zr = .[a1048576].End(3).Row
    ar = .[a8].CurrentRegion.FormulaR1C1
    zc = UBound(ar, 2)
End With
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)
With Sheets(2)
    Set MyCell = ActiveCell
    If .[b1048576].End(3).Row > 34 Then .Rows("35:" & .[b1048576].End(3).Row).Delete
    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 k = 0 To UBound(w)
                br(n + k + 1, 2) = w(k)
            Next
            k = (i - 2) / 20 * 27
            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(.Cells(k + 1, 1), .Cells(k + 7, 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, .Cells(k + 1, 1), .Cells(k + 7, 1))
            End If
            n = n + 7
        End If
    Next
    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, .Cells(n, 1), .Cells(n + 6, 1))
        For i = 0 To UBound(w)
            br(k + i - 1, 2) = w(i)
        Next
    End If
    .Rows("35:1048576").Clear
    .[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
    rng3.EntireRow.RowHeight = .[a28].RowHeight
    Rows(n + 6).Delete
End With
MyCell.Activate
Set rng = Nothing: Set rng2 = Nothing: Set MyCell = Nothing
Application.ScreenUpdating = 1
End Sub