Sub csv()
    Dim sFolder As String, sFiles As String
    Dim OutMail As Object
    Dim OutApp As Object
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.application")
    OutApp.session.logon
    Set OutMail = OutApp.createitem(0)
    With OutMail
    .To = "1@1.biz"
    .Subject = "Отгрузка"
    .display
    End With
    sFolder = ActiveWorkbook.Path
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
        sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
              Workbooks.Open sFolder & sFiles
       Dim r, ar, wb
Dim wbfilename As String, wbnewfilename As String, csv As String
Dim objFSO As Object, objFile As Object
Set wb = ActiveWorkbook
Set r = ActiveSheet.Cells(Rows.Count, 2).End(xlUp)
ar = Range(r.End(xlUp).Offset(1, 1), r.Offset(, 10))
wbfilename = wb.FullName
wbnewfilename = Replace(wbfilename, wb.Name, "beckup\" & wb.Name)
Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.getfile(wbfilename)
 With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.236220472440945)
        .RightMargin = Application.InchesToPoints(0.236220472440945)
        .TopMargin = Application.InchesToPoints(0.196850393700787)
        .BottomMargin = Application.InchesToPoints(0.196850393700787)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With
    Application.PrintCommunication = True
    wb.save
    Application.ScreenUpdating = False
With Workbooks.Add
    With .ActiveSheet
        .Cells(1).Resize(UBound(ar), UBound(ar, 2)) = ar
        .Columns(UBound(ar, 2) - 1).Delete
        For r = UBound(ar, 2) - 2 To 2 Step -1
        If IsEmpty(ar(1, r)) Then .Columns(r).Delete
        Next r
    End With
'Stop
    .SaveAs Replace(Replace(wb.FullName, wb.Name, "csv\" & wb.Name), "xls", "csv"), xlCSV, local:=True
    csv = ActiveWorkbook.FullName
End With
    OutMail.attachments.Add csv
wb.Close
objFile.Copy wbnewfilename
objFile.Delete
               ActiveWorkbook.Close False
        sFiles = Dir
    Loop
       Application.ScreenUpdating = True
'Stop
With Application
.DisplayAlerts = False
.Quit
End With
End Sub