'//Процедура обрабатывает одинаковым способом все файлы Excel в каталоге
Sub TestProc()
    Dim FSO As FileSystemObject
    Dim sourceFolder As Folder
    Dim fileItem As File
    
    Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
    Dim sModuleName As String, sFullName As String
    Dim sProcLines As String
    Dim lLineNum As Long
    
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set sourceFolder = FSO.GetFolder("C:\Users\Admin\Desktop\Остатки")
    
    For Each fileItem In sourceFolder.Files
        Dim currentBook As Workbook
        Dim source As Worksheet
        
        Set currentBook = Workbooks.Open(fileItem.Path, False, False)
        
        'добавляем новый стандартный модуль в активную книгу
    Set objVBComp = ActiveWorkbook.VBProject.VBComponents.Add(1)
    'получаем ссылку на коды модуля
    Set objCodeMod = objVBComp.CodeModule
    'узнаем количество строк в модуле
    '(т.к. VBA в зависимости от настроек может добавлять строки деклараций)
    lLineNum = objCodeMod.CountOfLines + 1
    'текст всставляемой процедуры
    sProcLines = "Function УРОВЕНЬСТРОКИ(ЯЧЕЙКА As Range) As Long" & vbCrLf & _
        "УРОВЕНЬСТРОКИ = ЯЧЕЙКА.Rows(1).OutlineLevel" & vbCrLf & _
        "End Function"
    'вставляем текст процедуры в тело нового модуля
    objCodeMod.InsertLines lLineNum, sProcLines
        
        
        Set source = currentBook.Sheets(1)
        Range("A4").FormulaR1C1 = "=УРОВЕНЬСТРОКИ()"

        
        'Columns("A:A").Select
   'Selection.Copy
  '  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
        Application.DisplayAlerts = False
        currentBook.Close True
        Application.DisplayAlerts = True
        
        Set source = Nothing
        Set currentBook = Nothing
    Next
    
End Sub