Sub Smeta()

Dim oFD As FileDialog
Dim sFolder$, Filename$, MyName$
Dim OutRow&, KolSmet&
Dim sh As Worksheet
Dim y, z, w As Range
Dim cr, cr2, cr3 As Integer

MyName = ThisWorkbook.Name
Set oFD = Application.FileDialog(msoFileDialogFilePicker)

With oFD
.Title = "Nazvanie"
.Filters.Add "Excel files", "*.xls*;*.xla*"
.InitialFileName = ThisWorkbook.Path & "\"
If .Show = 0 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = "Status......."

For cr = 1 To oFD.SelectedItems.Count
  
  If cr < oFD.SelectedItems.Count Then Sheets(Sheets.Count).Copy after:=Sheets(Sheets.Count)
  sFolder = .SelectedItems(cr)
  Filename = Dir(sFolder, vbNormal)

       'Workbooks("Filename").Activate ---------нужно ли это вообще здесь?
    For cr2 = 1 To Workbooks("Filename").Worksheets(Sheets.Count)-----------Жалуется на это место и на похожие дальше
      Set sh = Workbooks(Filename).Worksheets(cr2)
      Set y = sh.UsedRange.Find("*(nevazhnochto)", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByColumns)
      shTotal.Range("R2") = y.Offset(2, 0)
      shTotal.Cells(4, 2).EntireRow.HorizontalAlignment = xlCenter
      Set z = sh.UsedRange.Find("*(nevazhnochto)*", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByColumns)
      shTotal.Cells(4, 3) = z.Offset(-1, 0)
      Set w = sh.UsedRange.Find("*(nevazhnochto)*", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByColumns)
      shTotal.Range("R1") = w.Offset(-1, 0)
    Next cr2
   
    Workbooks(Filename).Close
    KolSmet = KolSmet + 1
    Filename = Dir()
Next

End With

Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Smet: " & KolSmet
Application.DisplayAlerts = True

End Sub

Sub Smeta()

Dim oFD As FileDialog
Dim sFolder$, Filename$, MyName$
Dim OutRow&, KolSmet&
Dim sh As Worksheet
Dim y, z, w As Range
Dim cr, cr2, cr3 As Integer

MyName = ThisWorkbook.Name
Set oFD = Application.FileDialog(msoFileDialogFilePicker)

With oFD
.Title = "Выберите сметы"
.Filters.Add "Excel files", "*.xls*;*.xla*"
.InitialFileName = ThisWorkbook.Path & "\"
If .Show = 0 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = "Ожидайте. Идёт процесс......."

For cr = 1 To oFD.SelectedItems.Count Step 1
  
  If cr < oFD.SelectedItems.Count Then Sheets(Sheets.Count).Copy after:=Sheets(Sheets.Count)
        
  With shTotal
  sFolder = oFD.SelectedItems(cr)
  Filename = Dir(sFolder, vbNormal)
  FileData = sFolder
  Workbooks.Open FileData
  Workbooks(Filename).Activate
  
    For Each sh In Workbooks(Filename).Worksheets
      Set y = sh.UsedRange.Find("*(наименование стройки и/или объекта)", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByColumns)
      Set z = sh.UsedRange.Find("*(наименование работ и затрат)*", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByColumns)
      .Cells(2, 1).Value = y.Offset(2, 0) & " " & z.Offset(-1, 0)
      Set w = sh.UsedRange.Find("*(наименование стройки и/или объекта)*", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByColumns)
      .Cells(1, 1) = w.Offset(-1, 0)
    Next sh
  Workbooks(Filename).Close
  End With
 
  KolSmet = KolSmet + 1
  
Next cr

End With


Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Итоговая таблица сформирована. Кол-во обработанных файлов со сметами: " & KolSmet
Application.DisplayAlerts = True

End Sub