Specifieke cellen toewijzen voor willekeurige waarde

Sub PickNamesAtRandom()

Dim HowMany As Integer
Dim NoOfNames As Long
Dim RandomNumber As Integer
Dim Names() As String 'Array to store randomly selected names
Dim i As Byte
Dim CellsOut As Long 'Variable to be used when entering names onto worksheet
Dim ArI As Byte 'Variable to increment through array indexes

Application.ScreenUpdating = False

HowMany = Range("D3").Value
CellsOut = 6

ReDim Names(1 To HowMany) 'Set the array size to how many names required
NoOfNames = Application.CountA(Range("A:A")) - 1 ' Find how many names in the list
i = 1

Do While i <= HowMany
RandomNo:
    RandomNumber = Application.RandBetween(2, NoOfNames + 1)
    'Check to see if the name has already been picked
    For ArI = LBound(Names) To UBound(Names)
        If Names(ArI) = Cells(RandomNumber, 1).Value Then
            GoTo RandomNo
        End If
    Next ArI
    Names(i) = Cells(RandomNumber, 1).Value ' Assign random name to the array
    i = i + 1
Loop

'Loop through the array and enter names onto the worksheet
For ArI = LBound(Names) To UBound(Names)

    Cells(CellsOut, 4) = Names(ArI)
    CellsOut = CellsOut + 1

Next ArI

Application.ScreenUpdating = True

End Sub

HowMany = Range("D3").Value
CellsOut = 6

For ArI = LBound(Names) To UBound(Names)

    Cells(CellsOut, 4) = Names(ArI)
    CellsOut = CellsOut + 1

Next ArI

Sub tsh()
    Dim i As Long, Br, Cl
    Dim Rngi As Range, Rngo As Range
    
    Set Rngi = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    Set Rngo = Range("$G$12").Resize(Int(Rngi.Count / 4) + 1, 4)
    Rngi.Offset(, 200).Name = "toeval"
    [toeval] = "=rand()"
    Br = [transpose(rank(toeval,toeval))]
    [toeval].ClearContents
    For Each Cl In Br
        i = i + 1
        Rngo(i) = Rngi(Cl)
    Next
End Sub