Option Explicit
Sub TestGenerierung()
Const MIN As Integer = 1
Const MAX As Integer = 70
Const ZEILEN As Long = 100
Const TABELLE As String = "Tabelle2"
Dim oSlist As Object
Dim oIlist As Object
Dim arrList(6) As Integer
Dim iInp As Integer, i As Integer
Dim strList As String
Dim Arr
Set oIlist = CreateObject("System.Collections.Sortedlist")
Set oSlist = CreateObject("System.Collections.Sortedlist")
oSlist.Clear
Do
oIlist.Clear
strList = ""
Do
iInp = WorksheetFunction.RandBetween(MIN, MAX)
On Error Resume Next
oIlist.Add iInp, ""
On Error GoTo 0
Loop Until oIlist.Count = 6
For i = 0 To oIlist.Count - 1
arrList(i) = oIlist.getkey(i)
strList = strList & CStr(oIlist.getkey(i))
Next i
On Error Resume Next
oSlist.Add strList, arrList
On Error GoTo 0
Loop Until oSlist.Count = ZEILEN
With Sheets(TABELLE)
.Range("A1").CurrentRegion.ClearContents
For i = 0 To oSlist.Count - 1
Arr = oSlist.GetByIndex(i)
.Cells(i + 1, 1).Resize(1, UBound(Arr)).Value = Arr
Next i
End With
Set oSlist = Nothing
Set oIlist = Nothing
End Sub