u = Cells(Rows.Count, "a").End(xlUp).Row

Sub Макрос2()
    u_1 = Cells(Rows.Count, "b").End(xlUp).Row
    u_2 = Cells(Rows.Count, "c").End(xlUp).Row
    u_3 = Cells(Rows.Count, "d").End(xlUp).Row
    u_4 = Application.Max(u_1, u_2, u_3) + 1
    ActiveSheet.ListObjects("Таблица1").Resize Range("a1:a" & u_4)
End Sub

Sub Макрос2()
    u_1 = Cells(1, Columns.Count).End(xlToLeft).Column
    u_3 = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To u_1
        u_2 = Cells(Rows.Count, i).End(xlUp).Row
        If u_2 > Cells(Rows.Count, i - 1).End(xlUp).Row Then u_3 = u_2
    Next
    ActiveSheet.ListObjects("Таблица1").Resize Range(Cells(1, 1), Cells(u_3 + 1, u_1))
End Sub

Sub Макрос1()

    With [Таблица1].ListObject
        .Resize .Range.Resize(2, 1)
    End With

End Sub

Sub Макрос2()
    
    With [Таблица1].ListObject.Range.CurrentRegion
        .ListObject.Resize .Resize(.Rows.Count - IsEmpty(.Cells(2, 1)))
    End With
    
End Sub

Sub sortirovka() 'Раскрытие таблицы
    Dim b As Boolean, r As Range, col as range
    With [Таблица1].ListObject
        Set r = .Range.CurrentRegion
        For Each col In r.Columns
            If col.Column = r.Column Then
                .Resize col.Next.Resize(2)
            ElseIf Not b Then
                b = True
                .Resize r.Resize(2, 2)
                .Resize r.Resize(2, 1)
            End If
            With Intersect(.Parent.UsedRange, col.EntireColumn)
                .sort .Cells(1), xlAscending, Header:=1
            End With
        Next
        .Resize r.Resize(r.Rows.Count - IsEmpty(r.Cells(2, 1)))
    End With
End Sub

Sub sortirovka() 'Раскрытие таблицы
    Dim r As Range, i&, j&, v As Variant, arr() As Variant
    With [Таблица1].ListObject
        With .Range.CurrentRegion
            If .Rows.Count < 2 Then Exit Sub
            ReDim Preserve arr(1 To .Rows.Count - 1, 1 To .Columns.Count)
            For j = 1 To .Columns.Count
                For Each r In .Columns(j)
                    i = 1
                    For Each v In BubbleSort(Intersect(r, r.Offset(1)).Value)
                        arr(i, j) = v
                        i = i + 1
            Next v, r, j
            Intersect(.Offset(1), .Cells).ClearContents
            .Cells(2, 1).Resize(i - 1, j - 1) = arr
        End With
        .Resize .Range.CurrentRegion
    End With
End Sub
Function BubbleSort(v As Variant) As Variant
    Dim i&, j&, b As Boolean
    If Not IsArray(v) Then BubbleSort = Array(v): Exit Function
    b = UBound(v) >= UBound(v, 2)
    For i = 1 To UBound(v, IIf(b, 1, 2)) - 1: For j = i To UBound(v, IIf(b, 1, 2))
        swap v(IIf(b, i, 1), IIf(b, 1, i)), v(IIf(b, j, 1), IIf(b, 1, j))
    Next j, i
    BubbleSort = v
End Function
Sub swap(ByRef a As Variant, b As Variant)
    If a < b Xor (a <> "") And (b <> "") Then: Dim c: c = a: a = b: b = c
End Sub