Sub perenos()
Dim Word As Object
Dim list As Document
Dim ta As Table
Dim ta2 As Table
Set sp = ThisWorkbook.Sheets("Справка")
Set Word = CreateObject("word.application")
Set list = Word.Documents.Add
'If secstr = "" Then MsgBox "Не все данные загружены, запустите полный цикл создания справки"
list.PageSetup.Orientation = wdOrientPortrait
    With list.PageSetup
........
........ далее всякого рода форматирование и упорядочивание
.........
    End If
End If
list.Close (wdDoNotSaveChanges)
Word.Quit
ThisWorkbook.Sheets("11111").Activate
    
    If ThisWorkbook.Sheets("11111").Cells(85, 1) <> "" Then MsgBox "Справка создана"

End Sub

            ipath = bs.Path & "\"
            s = ipath & Cells(i, 4) & ".xlsm" ' ячейка Cells(i, 4) содержит текст "подведение итогов"
            filt = s
            Set wb = GetObject(s)

Application.Run "'подведение итогов.xlsm'!test"

Application.Run wb!Module1.test

Sub sreda()
Dim sr()
s = 1
For d = 1 To 31
    dd = DateSerial(Year(Date), 9, d)
    If Weekday(dd, vbMonday) = 3 Then
        MsgBox "day   " & Day(dd)
        MsgBox "s   " & s
        sr(s) = Day(dd)
        s = s + 1
        MsgBox "s+1   " & s
    End If
Next
For s = 1 To 5
    MsgBox sr(s)
Next
End Sub

Windows("123.xlsm").Activate

Windows(АААА).Activate

Sub убрать()
    Application.DisplayFullScreen = True
End Sub
Sub показать()
    Application.DisplayFullScreen = False
End Sub