application.ScreenUpdating = false

Sub qq()
    Dim sh As Worksheet, lb As ListObject
    For Each sh In ActiveWorkbook.Worksheets
        For Each lb In sh.ListObjects
            Debug.Print lb.Name
        Next
    Next
End Sub

Sub Сохранить_НД_в_лист()
    Application.ScreenUpdating = False
    Dim path As String, iLinks As Variant, i As Long, vopros&

    vopros = MsgBox("Сохранить форму загрузки НД?", vbYesNo, "Сохранение")
    If vopros = vbYes Then

        path = ThisWorkbook.path
        ActiveSheet.Copy
        With ActiveWorkbook
            .Sheets(1).UsedRange.Cells.Value = .Sheets(1).UsedRange.Cells.Value
            .Sheets(1).Columns(7).Resize(, .Sheets(1).UsedRange.Columns.Count).Delete
            .SaveAs path & Application.PathSeparator & .Sheets(1).Name & " " & .Sheets(1).Range("B10") & " " & .Sheets(1).Range("B11") & ".xlsx", 51
            .Close False
            MsgBox "Форма сохранена в папку", vbInformation, "Важное сообщение:"
        End With
    End If
End Sub

NewExcel.Workbooks.Open "D:\Addin.xlam"

Sub Vanga_2()
    Dim x&
    With Selection
        x = InputBox("Укажите № столбца в выделении", , .Columns.Count)
        .Sort .Cells(1, x), xlDescending, Header:=xlNo
    End With
End Sub

Sub Vanga()
        Selection.Sort Selection.Cells(1, Selection.Columns.Count), xlDescending, Header:=xlNo
End Sub

Sub Преобразование()
    Dim cl As Range
    For Each cl In Selection
        cl = VisualVal(cl)
    Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("B13:B22")) Is Nothing Then
            If Target <> Empty Then
                Dim lr As Long, cell As Range

                With Worksheets("Лист2")
                    Set cell = .ListObjects("Таблица4").Range.Find(Target)
                    cell.Delete Shift:=xlUp
                    With .ListObjects("Таблица5").ListRows.Add(AlwaysInsert:=True)
                        .Range.Value = Target.Value
                    End With
                End With

                With Range("B13:B22").Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=ishod"    'ValidFormula
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
            End If
        End If
    End If
End Sub