Hi King,

habe dein Code eingebaut und es funktioniert fast gut ;-). das Problem jetzt ist das die Werte für y und p wenn es mehr als 6 bzw. mehr als 2 gibt gemischt ausgegeben werden was gut ist nur die übrigen sollten in den ersten Bereich am ende geschrieben werden.

Beispiel ich habe 8 x y jetzt möchte ich 6 von den 8 in Bereich 2 Schteiben was mit dem Makro gut funktioniert nur die restlichen 2 welche nicht im Bereich 2 übernommen werden dise sollen in Bereich 1 geschrieben werden.

Sub CommandButton2_Click()
Dim yarr(), parr()
   
  Randomize Timer
   
  Set Quelle = Sheets("FCLM_Data")
  Set ziel = Sheets("Board")
 
   
  z2 = 9: s2 = 3: z3 = 9: s3 = 12: z4 = 13: s4 = 12: ymax = 6: pmax = 2
   
  yvorh = Application.WorksheetFunction.CountIf(Quelle.Columns(13), "y")
  pvorh = Application.WorksheetFunction.CountIf(Quelle.Columns(13), "p")
   
  ReDim yarr(yvorh, 2)
  ReDim parr(pvorh, 2)
   
  For z1 = 1 To Quelle.Cells(Rows.Count, 1).End(xlUp).Row
    If s2 > 10 Then
      s2 = 3
      z2 = z2 + 2
    End If
     
    If Quelle.Cells(z1, 1) <> "" Then

      If Quelle.Cells(z1, 13) = "y" Then
         y = y + 1
         yarr(y, 1) = Quelle.Cells(z1, 1)
      ElseIf Quelle.Cells(z1, 13) = "p" Then
        p = p + 1
        parr(p, 1) = Quelle.Cells(z1, 1)
      Else
        ziel.Cells(z2, s2) = Quelle.Cells(z1, 1)
        s2 = s2 + 1
      End If
    End If
  Next z1
    
 For i = 1 To IIf(ymax <= yvorh, ymax, yvorh)
  If ymax <= yvorh Then
    Do
      zufall = Int(Rnd * UBound(yarr, 1)) + 1
    Loop Until yarr(zufall, 2) = ""
    yarr(zufall, 2) = "gezogen"
  Else
    zufall = i
  End If
     
    If s3 > 18 Then
      s3 = 12
      z3 = z3 + 2
    End If
    ziel.Cells(z3, s3) = yarr(zufall, 1)
    s3 = s3 + 1
  Next i
    
  For i = 1 To IIf(pmax <= pvorh, pmax, pvorh)
  If pmax <= pvorh Then
    Do
      zufall = Int(Rnd * UBound(parr, 1)) + 1
    Loop Until parr(zufall, 2) = ""
    parr(zufall, 2) = "gezogen"
  Else
    zufall = i
  End If
     
    If s4 > 18 Then
      s4 = 12
      z4 = z4 + 2
    End If
    ziel.Cells(z4, s4) = parr(zufall, 1)
    s4 = s4 + 1
  Next i
End Sub