Sub йййййййй()
'
' йййййййй Макрос
'

'
    Sheets("КМ-7").Visible = True
    Sheets(Array("КМ-6", "КМ-7")).Select
    Sheets("КМ-6").Activate
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    Sheets("КМ-7").Select
    ActiveWindow.SelectedSheets.Visible = False
    ActiveWindow.SmallScroll Down:=18
    Range("AA46:AN46").Select
    ActiveWindow.SmallScroll Down:=6
End Sub

=ЕСЛИ(BE9>=1,2;"1,05";ЕСЛИ(BE9>=1,4;"1,1";ЕСЛИ(BE9>=1,6;"1,15";"1")))

=ЕСЛИ(AX25:BL25=ОТ;"ОТ";" ")

Sub Письмо()
     
    Dim outApp As Object
    Dim outMail As Object
    Dim rng As Range
    Dim MyDate
    MyDate = Format(Date, "DD.MM.YYYY")
 
     
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
     
    iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Nothing
    Set rng = ActiveSheet.Range("AI32:CF34")
 
 
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)
 
    On Error Resume Next
    With outMail
  
      .To = "dddd@mail.ru"
      .Subject = "Отчет по сбору анкет " & MyDate
         
   
         
         
        .HTMLBody = "<p style='font-family:Tahoma;font-size:12'>" & "Добрый День!" & vbCrLf & _
                    "<p style='font-family:Tahoma;font-size:12'>" & "Отчет по анкетам:" & _
                    RangetoHTML(rng) & vbCrLf & _
                    "<p style='font-family:Tahoma;font-size:12'>" & "" & vbCrLf & _
                    "<p style='font-family:Tahoma;font-size:12'>" & ""
 
      
        .Display
    End With
    On Error GoTo 0
     
     
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
    Set outMail = Nothing
    Set outApp = Nothing
End Sub
 
 
Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        On Error GoTo 0
    End With
 
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    TempWB.Close savechanges:=False
 
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

.HtmlBody = Replace$(pSheet.MailEnvelope.Item.HtmlBody, _
        "align=center x:publishsource=", "align=left x:publishsource=") & .HtmlBody

Public Sub SendMail()
    Dim curSel As Object, pSheet As Worksheet
    Dim LRow As Long, outApp As Object, outMail As Object
    
    Set curSel = Selection: Set pSheet = ActiveSheet
    LRow = pSheet.Cells(pSheet.Rows.Count, 1).End(xlUp).Row
    pSheet.Range("AI32:CF34").Select
    
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)
    With outMail
        .Display
        .HtmlBody = Replace$(pSheet.MailEnvelope.Item.HtmlBody, _
        "align=center x:publishsource=", "align=left x:publishsource=") & .HtmlBody
        
        .HtmlBody = "<p style='font-family:Tahoma;font-size:12'>" & "Добрый день!" & .HtmlBody
                    
        .To = "kalonimarani@icloud.com" 'здесь e-mail кому
        .Subject = "ПОКАЗАТЕЛИ АНКЕТ" ' тема
    End With
    curSel.Select
End Sub