Excel - Extraer caracteres junto a algo determinado

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim a As Integer, Columna As Byte

    If Target.Column = 1 Then

      Columna = 2

       Application.EnableEvents = False

       For a = 1 To Len(Target.Text)

           If UCase(Mid$(Target.Text, a, 5)) = "PERRO" Then

              Cells(Target.Row, Columna) = Mid$(Target.Text, a - 5, 4)

              Columna = Columna + 1

           End If

       Next

       Application.EnableEvents = True

    End If

End Sub

Option Explicit

Sub Extraer_Numeros()

    Dim a As Integer, Fila As Long, Columna As Integer

    Application.EnableEvents = False

    Fila = 1

    While Cells(Fila, "A") <> ""

        Columna = 2

        For a = 1 To Len(Cells(Fila, "A"))

            If UCase(Mid$(Cells(Fila, "A"), a, 5)) = "PERRO" Then

                If IsNumeric(Mid$(Cells(Fila, "A"), a - 5, 4)) Then

                    Cells(Fila, Columna) = Mid$(Cells(Fila, "A"), a - 5, 4)

                    Columna = Columna + 1

                End If

            End If

        Next

        Fila = Fila + 1

    Wend

    Application.EnableEvents = True

End Sub

Sub Eventos_STOP()

        Application.EnableEvents = False

End Sub

Sub Eventos_START()

        Application.EnableEvents = True

End Sub