Sub Разделить()
    Dim arrSrc(), arrRes()
    Dim lr As Long, i As Long, ii As Long
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    arrSrc() = Range("A2:A" & lr).Value
    ReDim arrRes(1 To UBound(arrSrc), 1 To 2)
    For i = 1 To UBound(arrSrc)
        For ii = 1 To Len(arrSrc(i, 1))
            If Mid(arrSrc(i, 1), ii, 1) Like "[А-яЁё]" Then
                arrRes(i, 1) = Left(arrSrc(i, 1), ii - 1)
                arrRes(i, 2) = Mid(arrSrc(i, 1), ii)
                Exit For
            End If
        Next ii
    Next i
    Range("B2:C" & lr).Value = arrRes()
End Sub