Нужен макрос для Excel, отделяющий текст от цифр

Sub CodeToNextColumn()
    Dim cell As Range, rgX As Object
    Set rgX = CreateObject("VBScript.RegExp")
    rgX.IgnoreCase = True 'Ищем без различения по регистру (есть номера с буквами в нижнем регистре)
    rgX.Pattern = "[-A-Z\d]{2,}" 'Номер - это последовательность не менее 2-х символов, состоящая
                                 'из дефисов, латинских букв и цифр.
    Application.ScreenUpdating = False 'Отключаем обновление экрана для ускорения процесса.
    Set cell = Cells(1) 'Начинаем с верхней левой ячейки активного листа.
    While Not IsEmpty(cell) 'Идем по ячейкам вниз, пока не дойдем до пустой.
        'Если ячейка - не объединенная и в ней есть номер согласно шаблону - копируем номер вправо.
        If Not cell.MergeCells And rgX.Test(cell) Then cell.Offset(, 1) = rgX.Execute(cell)(0)
        Set cell = cell.Offset(1)
    Wend
    Application.ScreenUpdating = True 'Включаем обновление экрана.
End Sub

Sub CodeToNextColumn()
    Dim cell As Range, rgX As Object
    Set rgX = CreateObject("VBScript.RegExp")
    rgX.IgnoreCase = True 'Ищем без различения по регистру (есть номера с буквами в нижнем регистре)
    rgX.Pattern = "[-A-Z\d]{2,}" 'Номер - это последовательность не менее 2-х символов, состоящая
                                 'из дефисов, латинских букв и цифр.
    Application.ScreenUpdating = False 'Отключаем обновление экрана для ускорения процесса.
    Set cell = Cells(1) 'Начинаем с верхней левой ячейки активного листа.
    While Not IsEmpty(cell) 'Идем по ячейкам вниз, пока не дойдем до пустой.
        'Если ячейка - не объединенная и в ней есть номер согласно шаблону - копируем номер вправо.
        If Not cell.MergeCells And rgX.Test(cell) Then cell.Offset(, 1) = rgX.Execute(cell)(0)
        Set cell = cell.Offset(1)
    Wend
    Application.ScreenUpdating = True 'Включаем обновление экрана.
End Sub