Vornamen und Nachnamen trennen

111014

Aus einem markierten Bereich die Vornamen und Nachnamen trennen und in die Nachbarzellen einlesen:

Sub trennen()

Dim a%, b%, i%

Dim Zelle As Object

'Das Makro gilt

'für jede Zelle in der Markierung:

For Each Zelle In Selection

With Zelle

'Die erste Leerstelle suchen

a = InStr(.Value, " ")

'Schleife, falls mehrere durch leer getrennte Vornamen

'vorhanden sind, z. B. Hans Otto Huber

For i = 0 To Len(.Value)

b = InStr(Right(.Value, Len(.Value) - a), " ")

a = InStr(Right(.Value, Len(.Value) - a), " ") + a

Next

On Error Resume Next 'falls leere Zellen markiert sind

'Aufteilen auf die 1. Zelle rechts und die 2. Zelle rechts

'Vorname

Cells(.Row, .Column + 1).Value = Left(.Value, a - 1)

'Nachname

Cells(.Row, .Column + 2).Value = Right(.Value, Len(.Value) - a)

End With

Next

End Sub