Sub SendMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = "Mail1@mail.ru"
        .From = "Mail22mail.ru"
        .SetOnBehalfOfName = "mail1@mail.ru"
        .Subject = "что то"
        .Body = "что нибудь"
        .Send
    End With
End Sub

Sub copyUS()
Dim n
n = 2
DoDim LastRow As Long, Rw As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Лист1")
Rw = .Cells(Rows.Count, 11).End(xlUp).Row + 1
For i = 2 To LastRow
If Cells(i, 1) = Cells(n, 8) Then
Range(Cells(i, 1), Cells(i, 3)).Copy .Cells(Rw, 11)
Cells(3, 11).Select
Rw = Rw + 1
End If
Next
End With
If Cells(n, 8) = "" Then
Exit Do
End If
n = n + 1
Loop
End Sub