Sub clean_sch() 'Удаляет лишние листы в книке счетов
Dim iWb As Workbook
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook
  'открываю книгу со счетами из текущей папки, название книги в ячейке 'B1' листа 'Счета'
  Set iWb = Workbooks.Open(.Path & "\" & .Worksheets("Счета").Range("B1").Text)
End With
Application.Run Macro:=iWb.Name & "!ModDeliter.Delet_sch"
iWb.Close True
Application.ScreenUpdating = True
MsgBox "Done!"
Exit Sub
ErrHandler:
    MsgBox "При выполнении макроса возникла ошибка!", vbCritical
End Sub

Sub Delet_sch()
  Dim bo As Boolean
  Application.DisplayAlerts = False 'отключаю запрос на удаление
  bo = True
  Do While bo 'делаю пока = true
    With ThisWorkbook
      If .Sheets(.Sheets.Count).Name = "ТН" Then bo = False
      If bo Then .Sheets(.Sheets.Count).Delete
    End With
  Loop
  Application.DisplayAlerts = True
End Sub

Sub clean_sch() 'Удаляет лишние листы в книке счетов
Dim iWb As Workbook
Dim iSh As Worksheet
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook
  'открываю книгу со счетами из текущей папки, название книги в ячейке 'B1' листа 'Счета'
  Set iWb = Workbooks.Open(.Path & "\" & .Worksheets("Счета").Range("B1").Text)
End With
If Not iWb Is Nothing Then
  For Each iSh In iWb.Worksheets
    If iSh.Name <> "ТН" Then iSh.Delete
  Next
End If
iWb.Close True
Application.ScreenUpdating = True
MsgBox "Done!"
Exit Sub
ErrHandler:
    MsgBox "При выполнении макроса возникла ошибка!", vbCritical
End Sub

Sub Del_Wsch() 'Удаляет лишние листы в книке счетов
Dim iWb As Workbook
Dim iSh As Worksheet
Dim wsStart&, I&
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook
  'открываю книгу со счетами из текущей папки, название книги в ячейке 'B1' листа 'Счета'
  Set iWb = Workbooks.Open(.Path & "\" & .Worksheets("Счета").Range("B1").Text)
End With
If Not iWb Is Nothing Then
  wsStart = iWb.Worksheets("ТН").Index + 1
  For I = wsStart To iWb.Worksheets.Count
    iWb.Worksheets(I).Delete
  Next
End If
iWb.Close True
Application.ScreenUpdating = True
MsgBox "Done!"
Exit Sub
ErrHandler:
    MsgBox "При выполнении макроса возникла ошибка!", vbCritical
End Sub