Hallo,

ich habe leider aus dem Roman nicht genau herauslesen können, was du eigentlich möchtest. Die Erstellung der Gruppen und die zufällige Zuweisung könnte hiermit realisiert werden:

Option Explicit

Dim anzahlVergeben As Integer

Public Sub generate_groups()
    Dim wks As Worksheet
    Set wks = Worksheets("Tabelle1")    'Tabelle anpassen
    
    Dim SpielerProGruppe As Integer
    SpielerProGruppe = 3                 'Spieler pro Gruppe
    
    Dim intAnzahl As Integer, i As Integer
    intAnzahl = wks.Cells(Rows.Count, 1).End(xlUp).Row
    
    If intAnzahl Mod SpielerProGruppe <> 0 Then
        MsgBox "Anzahl Spieler pro Gruppe gehen nicht auf.", vbInformation
        Exit Sub
    End If
    
    Dim strSpieler() As String
    ReDim strSpieler(intAnzahl - 1)
    Dim strSpielerV() As String
    ReDim strSpielerV(intAnzahl - 1)
    Dim strGruppe() As String
    ReDim strGruppe(SpielerProGruppe - 1)
    
    For i = 1 To intAnzahl
        strSpieler(i - 1) = wks.Cells(i, 1)
    Next i
    
    anzahlVergeben = 0
    Dim j As Integer, k As Integer
    For i = 1 To intAnzahl / SpielerProGruppe
        k = 0
        Call get_gruppe(intAnzahl, strGruppe(), strSpieler(), strSpielerV, SpielerProGruppe)
        For j = 3 To 3 + (SpielerProGruppe - 1)
            wks.Cells(i, j) = strGruppe(k)
            k = k + 1
        Next j
    Next i
End Sub

Private Sub get_gruppe(ByVal AnzahlSpieler As Integer, ByRef Gruppe() As String, ByRef Spieler() As String, ByRef SpielerV() As String, ByVal SpielerProGruppe As Integer)
    Dim i As Integer, j As Integer
    For i = 0 To SpielerProGruppe - 1
        Randomize
        j = Int((AnzahlSpieler - 1 + 1) * Rnd + 1)
        Do While isInGroup(SpielerV(), Spieler(j - 1))
            Randomize
            j = Int((AnzahlSpieler - 1 + 1) * Rnd + 1)
        Loop
        Gruppe(i) = Spieler(j - 1)
        SpielerV(anzahlVergeben) = Spieler(j - 1)
        anzahlVergeben = anzahlVergeben + 1
    Next i
End Sub

Private Function isInGroup(ByRef SpielerV() As String, ByVal Spieler As String) As Boolean
    Dim i As Integer
    For i = 0 To anzahlVergeben - 1
        If SpielerV(i) = Spieler Then
            isInGroup = True
            Exit Function
        End If
    Next i
    isInGroup = False
End Function

Hierbei ist davon auszugehen, dass alle teilnehmenden Spieler in der Spalte A untereinander stehen. Kein Spielername darf doppelt vorkommen!

Gruß