'//Процедура обрабатывает одинаковым способом все файлы 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

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim str As String

If Target.Count > 1 Then Exit Sub
If Target.Column = 1 Then
    str = Target.Value
    Application.EnableEvents = False
    r = Cells(Rows.Count, 2).End(xlUp).Row
     Range("A2:A" & r).ClearContents
    Target.Value = str
End If
  Application.EnableEvents = True
End Sub

Dim x as  Sheets

If нужное условие 1 Then x = "Лист1"
If нужное условие 2 Then x = "Лист2"

дальше код
With Sheets(x)
дальше код
End If
End If

  If Flag = False Then Me.Label19 = "Не найдено"
End Sub

Sub Finder()
Dim i As Long, LastRow As Long, Flag As Boolean
    If Basis = "" Then Exit Sub
    With Sheets("Лист1")
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To LastRow
            Debug.Print .Cells(i, 1)
            If .Cells(i, 1) = Basis1 Then
                
                    Me.Label19 = .Cells(i, 2)
                    iRow = i
                    Flag = True
                    Exit For
                End If
        Next
    End With
    If Flag = False Then Me.Label19 = "Не найдено"
End Sub

Private Sub CommandButton3_Click()
'   ---------------------------------
    Dim i%, rng As Range
'   ---------------------------------
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) Then
            Set rng = Range("a1:a" & wbSht.Rows.Count).Find(Me.ListBox1.List(i))
            Rows(rng.Row).Delete
        End If
    Next i
    Me.ListBox1.Clear
    With wbSht
        i = .Range("a" & .Rows.Count).End(xlUp).Row
        If i > 2 Then
            Me.ListBox1.List = .Range(.[b2], .Range("a" & i)).Value
        Else: If Not IsEmpty(.[a2].Value) Then Me.ListBox1.AddItem .[a2]
        End If
    End With
End Sub