Sub Obrezanie()
Dim i As Long
Dim iLastRow As Long
Dim mo As Object
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
   With CreateObject("VBScript.RegExp")
     .Global = True
     .MultiLine = True
     .Pattern = "([0-9|A-Z|А-Я])"
    For i = 2 To iLastRow
      If .Test(Cells(i, 1)) Then
        Set mo = .Execute(Cells(i, 1))
        If Mid(Cells(i, 1), mo(1).FirstIndex - 1, 1) = "" Then
         Cells(i, 1) = Left(Cells(i, 1), mo(1).FirstIndex - 1)
        Else
         Cells(i, 1) = Left(Cells(i, 1), mo(1).FirstIndex)
        End If
      End If
    Next
   End With
End Sub