Se puede crear una macro que separe nombres de apellidos y personas jurídicas?

Esto nunca ha sido una tarea sencilla especialmente con nombres hispanos ya que varían mucho, algunos tienen dos nombres y dos apellidos, otros solo tiene un nombre, y el peor dolor de cabeza del programador son los DE y DEL.

Cuando alguien tiene en su nombre digamos JUAN PEREZ DEL CASTILLO

Te he hecho un código que trabaja bastante bien siempre y cuando no hayan nombre muy fuera de lo normal.

Son dos macros, solo debes ejecutar la primera. Lo que hace es, si encuentra 3 palabras, asume que es 1 nombre + 2 apellidos, si encuentra 4 asume que es 2 nombres + 2 apellidos, y si encuentra más de 4, asume que hay algún DE o DEL, entonces llama a la otra macro que procesa el Array, encuentra donde esta el DE o DEL y lo combina con el nombre que le sigue, y devuelve un nuevo array de 4 o 3.

Me ha tomado un poco de tiempo hacerlo eh, seguro se puede mejorar, pero por ahora a mi me funciona así: video demo

Este es el código que debes ejecutar:

Sub SepararNombres()
Dim LongNombre As Byte
Dim NombresArr() As String
Dim uF As Long
Dim rCell As Range, rRng As Range
uF = Range("E" & Rows.Count).End(xlUp).Row
Set rRng = Range("E2:E" & uF)
For Each rCell In rRng.Cells
    NombresArr = Split(rCell.Value)
    If UBound(NombresArr) = 2 Then
        Cells(rCell.Row, 6).Value = NombresArr(1)
        Cells(rCell.Row, 7).Value = NombresArr(2)
        Cells(rCell.Row, 8).Value = NombresArr(0)
    ElseIf UBound(NombresArr) = 3 Then
        Cells(rCell.Row, 6).Value = NombresArr(2)
        Cells(rCell.Row, 7).Value = NombresArr(3)
        Cells(rCell.Row, 8).Value = NombresArr(0)
        Cells(rCell.Row, 9).Value = NombresArr(1)
    ElseIf UBound(NombresArr) > 3 Then
        LongNombre = UBound(NombresArr)
        Call NombreLargo(NombresArr, LongNombre)
        Cells(rCell.Row, 6).Value = NombresArr(2)
        Cells(rCell.Row, 7).Value = NombresArr(3)
        Cells(rCell.Row, 8).Value = NombresArr(0)
        Cells(rCell.Row, 9).Value = NombresArr(1)
    End If
Next rCell
End Sub

Y este otro, pegalo en el mismo modulo en alguna parte, este código lo único que hace es procesar los nombres que tengan mas de 4 palabras y se lo devuelve modificado a la función principal:

Sub NombreLargo(ByRef NombreArray() As String, ArrCnt As Byte)
Dim i As Byte, CombinePos As Byte
For i = LBound(NombreArray) To UBound(NombreArray)
    If NombreArray(i) = "DE" Or NombreArray(i) = "DEL" Then
        CombinePos = i + 1
        NombreArray(i) = NombreArray(i) & " " & NombreArray(i + 1)
        On Error Resume Next
        NombreArray(CombinePos) = NombreArray(CombinePos + 1)
        ReDim Preserve NombreArray(UBound(NombreArray) - 1)
    Exit For
    End If
Next i
End Sub

Andy

Me concentre tanto en lo de separar el nombre que olvide lo de juridico.

Nomas hay que verificar si la columna D tiene dato o no.

Esta es la macro actualizada:

Sub SepararNombres()
Dim LongNombre As Byte
Dim NombresArr() As String
Dim uF As Long
Dim rCell As Range, rRng As Range
uF = Range("E" & Rows.Count).End(xlUp).Row
Set rRng = Range("E2:E" & uF)
For Each rCell In rRng.Cells
    If IsEmpty(Cells(rCell.Row, 4)) Then
    NombresArr = Split(rCell.Value)
    If UBound(NombresArr) = 2 Then
        Cells(rCell.Row, 6).Value = NombresArr(1)
        Cells(rCell.Row, 7).Value = NombresArr(2)
        Cells(rCell.Row, 8).Value = NombresArr(0)
    ElseIf UBound(NombresArr) = 3 Then
        Cells(rCell.Row, 6).Value = NombresArr(2)
        Cells(rCell.Row, 7).Value = NombresArr(3)
        Cells(rCell.Row, 8).Value = NombresArr(0)
        Cells(rCell.Row, 9).Value = NombresArr(1)
    ElseIf UBound(NombresArr) > 3 Then
        LongNombre = UBound(NombresArr)
        Call NombreLargo(NombresArr, LongNombre)
        Cells(rCell.Row, 6).Value = NombresArr(2)
        Cells(rCell.Row, 7).Value = NombresArr(3)
        Cells(rCell.Row, 8).Value = NombresArr(0)
        Cells(rCell.Row, 9).Value = NombresArr(1)
    End If
    Else
        Cells(rCell.Row, 10).Value = rCell.Value
    End If
Next rCell
End Sub

Solo agregue un par de lineas, es un IF.

La segunda macro se queda como está.

¡Gracias! eres un genio de visual basic, espero aprender de vos.