Sub ЛистыВфайл()
     Dim List As Worksheet, iPath$
     With Application
       .ScreenUpdating = False
       .DisplayAlerts = False
       .EnableEvents = False
       For Each List In .ThisWorkbook.Worksheets
          If List.Name <> "Первый" And List.Name <> "Инвойс" And List.Name <> "Дата" Then
            List.Copy
            With .ActiveSheet
               iPath = Range("A1")
              .UsedRange.Value = .UsedRange.Value
              .Buttons.Delete 'Óäàëÿåì òîëüêî êíîïêè
              '.DrawingObjects.Delete 'Óäàëÿåì âñå ýëåìåíòû
              .SaveAs Filename:=iPath '$ & List.Name
              .Parent.Close saveChanges:=True
            End With
         End If
       Next
       .EnableEvents = True
       .DisplayAlerts = True
       .ScreenUpdating = True
     End With
End Sub