Sub T_366()
    On Error Resume Next
    Dim objC As Range
    For Each objC In Selection.SpecialCells(xlCellTypeConstants)
        objC = Mid(objC, InStr(objC, ",")+1)
    Next
End Sub

Sub T_366()
    On Error Resume Next
    Dim objC As Range
    For Each objC In Selection.SpecialCells(xlCellTypeConstants)
        objC = Split(objC, " ")(0) & ""
    Next
End Sub

Option Explicit
  
Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object, Wb As Workbook
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
  
    Application.ScreenUpdating = False
    On Error Resume Next
    '??????? ??????????? ? Outlook ???? ?? ??? ??????
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook ??????, ??????? ??????
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    
    Set objMail = objOutlookApp.CreateItem(0)   '??????? ????? ?????????
    '???? ?? ?????????? ??????? ?????????? ??? ???????? ????????? - ???????
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
     
    sTo = "moscva87@yandex.ru"    '????(????? ???????? ????????? ?? ?????? - sTo = Range("A1").Value)
    sSubject = "Прайс-лист1"    '???? ?????(????? ???????? ????????? ?? ?????? - sSubject = Range("A2").Value)
    sBody = "Прайс-лист1"    '????? ??????(????? ???????? ????????? ?? ?????? - sBody = Range("A3").Value)
      '????????(?????? ???? ? ????? ????? ???????? ????????? ?? ?????? - sAttachment = Range("A4").Value)
     
     
    ActiveSheet.Copy
    Set Wb = ActiveSheet.Parent
    Wb.SaveAs Filename:=sAttachment, _
              FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Wb.Close (False)
     
     
    '??????? ?????????
    With objMail
        .To = sTo '????? ??????????
        .CC = "" '????? ??? ?????
        .BCC = "" '????? ??? ??????? ?????
        .Subject = sSubject '???? ?????????
        .Body = sBody '????? ?????????
        '.HTMLBody = sBody '???? ?????????? ??????????????? ????? ?????????(??????, ???? ? ?.?.)
        .Attachments.Add ActiveWorkbook.FullName  '????? ????????? ???????? ????? ?????? sAttachment ??????? ActiveWorkbook.FullName
    Set .SendUsingAccount = objOutlookApp.Session.Accounts.Item("pmsa87@mail.ru")
        .Send ', ???? ?????????? ??????????? ?????????, ? ?? ?????????? ??? ?????????
    End With
  
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
 
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    'раскомментировать строку, если в Outlook несколько учетных записей и нужно подключиться к конкретной(только если Outlook закрыть)
    '   [параметры]: Session.Logon "имя профиля","пароль",[показывать окно выбора профиля], [запускать в новой сессии]
    'objOutlookApp.Session.Logon "profile","1234",False, True
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
    sTo = "moscva.87@yandex.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sSubject = "Прайс-лист"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = "Привет от Excel-VBA"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
    sAttachment = "D:\555\R8(пробник).xls"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
 
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = "" 'адрес для копии
        .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        'добавляем вложение, если файл по указанному пути существует(dir проверяет это)
        If sAttachment <> "" Then
            If Dir(sAttachment, 16) <> "" Then
                .Attachments.Add sAttachment 'просто вложение
                'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
            End If
        End If
        .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

Sub Replacer()
Dim rng As Range
Dim arr, aOne(1 To 1, 1 To 1)
Dim t!, a&, r&, c&, n&, AC&, f As Boolean
 
t = Timer: Set rng = Selection
Application.ScreenUpdating = False
AC = Application.Calculation: Application.Calculation = xlCalculationManual
 
For a = 1 To rng.Areas.Count
    arr = rng.Areas(a).Value
    If Not IsArray(arr) Then aOne(1, 1) = arr: arr = aOne
 
    For c = 1 To UBound(arr, 2)
        For r = 1 To UBound(arr, 1)
            If arr(r, c) Like "*,*" Then
                arr(r, c) = Replace$(arr(r, c), ",", ".")
                n = n + 1: f = True
            End If
        Next r
    Next c
 
    If f Then
        f = False
        rng.Areas(a).NumberFormat = "@"
        rng.Areas(a).Value = arr
    End If
Next a
 
Application.Calculation = AC
Application.ScreenUpdating = True
 
If n = 0 Then MsgBox "There is NO COMMAS in Selection", vbExclamation, Format$(Timer - t, "0.00 sec"): Exit Sub
MsgBox "Succsessfully replace the COMMAS to DOTs: " & Format$(n, "#,##0"), vbInformation, Format$(Timer - t, "0.00 sec")
End Sub

Sub Символ()
Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart
End Sub

Sub FixActiveSheet()
    FixSheet ActiveSheet
End Sub
 
Sub FixSheet(sh As Worksheet)
    With sh.UsedRange
        .NumberFormat = "@"
        Dim arr As Variant
        arr = .Value
        .Value = arr
        .NumberFormat = "General"
    End With
End Sub

Sub Convert_Text_to_Numbers()
Selection.NumberFormat = "General"
Selection.Value = Selection.Value
End Sub

Sub SendWorkbook()
    ActiveWorkbook.SendMail Recipients:="moscva.87@yandex.ru", Subject:="Прайс-Лист"
End Sub>