Option Explicit
Sub SaveFilesAs()
    Dim FilesToOpen, i As Integer
    Dim iBeginRange As Object, wsSh As Object, newWS As Object, wsInNewWB As Object
    Dim sCopyAddress As String
    Dim lCalc As Long, lCol As Long, lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
    Dim wbAct As Workbook, newWB As Workbook
    
    'вызываем диалог выбора файлов для импорта
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="MS Excel files (*.xls*), *.xls*", MultiSelect:=True, Title:="Files to Merge")
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбран ни один файл!"
        Exit Sub
    End If
    
    'диапазон выборки с книг - c первой ячейки
    Set iBeginRange = Range("A1")
    
    'отключаем обновление экрана, автопересчет формул и отслеживание событий
    'для скорости выполнения кода и для избежания ошибок, если в книгах есть иные коды
    With Application
        lCalc = .Calculation
        .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
    End With
    
    'цикл по книгам
    i = 1
    While i <= UBound(FilesToOpen)
        Set wbAct = Workbooks.Open(Filename:=FilesToOpen(i))

        Set newWS = wbAct.Sheets("Смета")
       
        'создаем новую книгу newWB с одним листом newWs
        Set newWB = Workbooks.Add(xlWBATWorksheet)
        newWB.Worksheets.Add().Name = "Смета"
        Set wsInNewWB = newWB.Worksheets("Смета")
        
        'копируем значения с созданного листа
        newWS.Copy
        wsInNewWB.Paste
                
        'сохраним созданную книгу как xlsx
        newWB.SaveAs _
        Filename:=wbAct.Path & "" & Replace(wbAct.Name, ".xlsb", ".xlsx", , , vbTextCompare), FileFormat:=xlWorkbookDefault
        newWB.Close savechanges:=True
         
        'закрываем текущую книгу и не сохраняем изменения
        wbAct.Close savechanges:=False
        i = i + 1
    Wend
    
    With Application
        .ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc
    End With
End Sub