Sub SendMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
     
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")   'запускаем Outlook в скрытом режиме
    OutApp.Session.Logon      
    On Error GoTo cleanup  'если не запустился - выходим 
    Set OutMail = OutApp.CreateItem(0)   'создаем новое сообщение
    On Error Resume Next
    'заполняем поля сообщения
    With OutMail
        .To = Range("A1").Value
        .Subject = Range("A2").Value
        .Body = Range("A3").Value
        .Attachments.Add Range("A4").Value
        'команду Send можно заменить на Display, чтобы посмотреть сообщение перед отправкой 
        .Send
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Sub transponir22() ' переносим файлы в общий отчет
Dim x1 As Long, rn As Range
Set rn = Cells(ActiveCell.Row, 1).Copy
Workbooks.Open Filename:="D:\Данные\Хранение.xlsm" ' открываем файл отчета
x1 = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(x1, 1), Cells(x1 + rn.Rows.Count - 1, 1)).NumberFormat = "@"
Range(Cells(x1, 1), Cells(x1 + rn.Rows.Count - 1, rn.Columns.Count)).Value = rn.Value
ActiveWorkbook.Close 1 'закрываем с сохранением
End Sub

onst DB_FULLNAME = "C:\tmp\База данных.xlsm"
 
Sub УшлаНаБазу()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
     
    Dim sName As String
    sName = fso.getfilename(DB_FULLNAME)
     
    Dim bClose As Boolean
    Dim wb As Workbook
    On Error Resume Next
        Set wb = Workbooks(sName)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = Workbooks.Open(DB_FULLNAME, False, False)
        bClose = True
    End If
     
    Dim shI As Worksheet: Set shI = Workbooks("Отправка.xlsm").Worksheets("Инф")
    Dim shZ As Worksheet: Set shZ = wb.Worksheets("Заявки")
      
    Dim a As Variant
    a = shI.Range("A8:J8")
      
    Dim y As Long
    If a(1, 1) <> "" Then
        On Error Resume Next
            y = WorksheetFunction.Match(a(1, 1), shZ.Columns(1), 0)
        On Error GoTo 0
    End If
      
    If y > 0 Then
        shZ.Cells(y, 1).Resize(1, UBound(a, 2)).Value = a
    End If
     
    If bClose Then
        Application.DisplayAlerts = False
        wb.Close True
        Application.DisplayAlerts = True
    End If
End Sub

Sub Запись()
Application.ScreenUpdating = False
'Обращаться с книгами будем через переменные
'(кода меньше писать и не промахнёшься мимо нужной книги)
Dim Исходная As Excel.Workbook, Конечная As Excel.Workbook
Dim nss As Long
Set Исходная = ActiveWorkbook
'открываем книгу
Set Конечная = Workbooks.Open("D:\Данные\Хранение.xlsm")
'копируем строку
        Исходная.Worksheets(1).Rows("2:2").Copy
        'выбираем номер начальной строки для поиска последней записи
        nss = 2
        'ищем последнюю запись
        Do While Конечная.Worksheets(1).Range("B" & nss).Value <> ""
            'увеличиваем номер строки на 1
            nss = nss + 1
        Loop
        'вставляем строку из буфера
        Конечная.Worksheets(1).Rows(nss).PasteSpecial
        Конечная.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub