Sub Сохранить()
  Dim rn&, rk&, iPath$, I&
  With Application.FileDialog(msoFileDialogFolderPicker)
    .ButtonName = "Выбрать"
    .Title = "Выберите и откройте папку для сохранения файлов."
    .InitialFileName = iPath
    If .Show = False Then Exit Sub
    iPath = .SelectedItems(1) & "\"
  End With
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
      
  Sheets(Array("АА", "ББ")).Copy
  For I = 1 To 2
    With Sheets(I)
      .Cells.Copy
      .Cells.PasteSpecial Paste:=xlPasteValues
      .UsedRange.Value = .UsedRange.Value
       On Error Resume Next
      .Columns("I:W").Delete
      .Buttons.Delete 'Удаляем кнопки
      .DrawingObjects.Delete 'Удаляем все элеме
      .Range("A1").Select
    End With
  Next I
  With Sheets("АА")
    rn = .Range("B" & Rows.Count).End(xlUp).Row
    rk = .Range("H" & Rows.Count).End(xlUp).Row
    Range("A" & rn & ":H" & rk).Clear
  End With
  
  ActiveWorkbook.SaveAs iPath & "ААББ.xls"
  ActiveWorkbook.Close False
  Application.DisplayAlerts = True: Application.ScreenUpdating = True
  MsgBox "Готово! Ищем в " & iPath & "ААББ.xls"
End Sub