Sub SpielerRunde()
Range(Cells(1, 2), Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)) = ""
Randomize Timer
Dim ZeilenA As Long
Dim AnzTische As Integer, SpielerRaus As Integer, endeindex As Integer, spalten As Integer, zeilen As Integer, gezogen As Integer
Dim allezahlen As Integer, t As Integer, z As Integer, zaehler As Integer, zaehler1 As Integer, ziehung As Integer
ZeilenA = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
AnzTische = 8
SpielerRaus = ZeilenA - AnzTische * 6
endeindex = ZeilenA
spalten = 3
zeilen = 2
ReDim zuzahl(ZeilenA) As String
ReDim arr1(6, AnzTische) As Variant
ReDim arr2(6, AnzTische) As Variant
ReDim zuzahl(ZeilenA) As String
ReDim zahl(ZeilenA) As String
ReDim ArrIndex(AnzTische) As Integer
Cells(1, 1) = "NamensListe"
For zaehler = 1 To UBound(ArrIndex())
ArrIndex(zaehler) = zaehler
Cells(1, zaehler + 2) = "1 Runde " & "Tisch " & zaehler
Next zaehler
For allezahlen = 2 To 49
zuzahl(allezahlen - 1) = Cells(allezahlen, 1)
Next allezahlen
For ziehung = 1 To 8 * 6
gezogen = Int(Rnd * endeindex) + 1
zahl(ziehung) = zuzahl(gezogen)
zuzahl(gezogen) = zuzahl(endeindex)
endeindex = endeindex - 1
ReDim Preserve zuzahl(endeindex)
Cells(zeilen, spalten) = zahl(ziehung)
If spalten = 2 + AnzTische Then
zeilen = zeilen + 1
spalten = 3
Else
spalten = spalten + 1
End If
Next ziehung
arr1() = Range(Cells(2, 3), Cells(7, 2 + AnzTische))
arr2() = Range(Cells(2, 3), Cells(7, 2 + AnzTische))
For z = 0 To 4 'hhhh
For t = 1 To 5
For zaehler1 = 1 To UBound(ArrIndex())
If ArrIndex(zaehler1) > AnzTische Then ArrIndex(zaehler1) = 1
Next zaehler1
arr2(t, ArrIndex(1)) = arr1(t, UBound(ArrIndex()))
For zaehler1 = 1 To UBound(ArrIndex()) - 1
arr2(t, ArrIndex(zaehler1 + 1)) = arr1(t, zaehler1)
Next zaehler1
For zaehler1 = 1 To UBound(ArrIndex())
ArrIndex(zaehler1) = ArrIndex(zaehler1) + 1
Next zaehler1
Next t
Range(Cells(z * 7 + 9, 3), Cells(z * 7 + 14, 2 + AnzTische)) = arr2()
arr1() = Range(Cells(z * 7 + 9, 3), Cells(z * 7 + 14, 2 + AnzTische))
arr2() = Range(Cells(z * 7 + 9, 3), Cells(z * 7 + 14, 2 + AnzTische))
For zaehler = 1 To UBound(ArrIndex())
ArrIndex(zaehler) = zaehler
Cells(z * 7 + 8, zaehler + 2) = z + 2 & " Runde " & "Tisch " & zaehler
Next zaehler
Next z
End Sub