Option Explicit

Sub Suchen_ergaenzen()
Dim iTab1 As Integer
Dim SearchName As String, InsertName As String
Dim wks1 As Worksheet, wks2 As Worksheet
Dim LowLetzte As Long, Searchtxt As Range, CellRange As String

'Blattname setzen
Set wks1 = Sheets("Personen")
Set wks2 = Sheets("Gruppen")
'Letzte beschriebene Zeile in Blatt mit den Personendaten ermitteln
LowLetzte = wks1.Range("A65536").End(xlUp).Row
'Schleife um jeden Eintrag in Personenblatt zu prüfen
For iTab1 = 2 To LowLetzte
'Personen ID ermitteln
SearchName = Mid(wks1.Cells(iTab1, 1), 1, InStr(wks1.Cells(iTab1, 1), " ") - 1)
'Personennamen ermitteln
InsertName = Mid(wks1.Cells(iTab1, 1), InStr(wks1.Cells(iTab1, 1), " ") + 1, Len(wks1.Cells(iTab1, 1)))
'Bereich der in Gruppenblatt durchsucht werden soo festlegen
With wks2.Range("A1:W65536")
'Find-Methode starten um in Gruppenblatt übereinstimmungen zu finden
Set Searchtxt = .Find(What:=SearchName, LookIn:=xlValues)
If Not Searchtxt Is Nothing Then
CellRange = Searchtxt.Address
Do
'Wenn Übereinstimmung gefunden, den Text in der Zelle um den Personennamen erweitern
wks2.Range(CellRange) = wks2.Range(CellRange) & " " & InsertName
'Nächste Suche starten
Set Searchtxt = .FindNext(Searchtxt)
Loop While Not Searchtxt Is Nothing And Searchtxt.Address <> CellRange
End If
End With
Next
End Sub

Set wks1 = Sheets("Personen")
Set wks2 = Sheets("Gruppen")