Hy xlKing, ich muss sagen du bist der King :-) das ist das was ich mir vorgestellt habe.
Danke dir viel mals.
Sub CommandButton2_Click()
Dim z1 As Long, z2 As Long, s2 As Long
z2 = 9: s2 = 3: z3 = 9: s3 = 12: z4 = 13: s4 = 12
For z1 = 1 To Sheets("FCLM_Data").Cells(Rows.Count, 1).End(xlUp).Row
If s2 > 10 Then
s2 = 3
z2 = z2 + 2
End If
If s3 > 18 Then
s3 = 12
z3 = z3 + 2
End If
If s4 > 18 Then
s4 = 12
z4 = z4 + 2
End If
If Sheets("FCLM_Data").Cells(z1, 1) <> "" Then
If Sheets("FCLM_Data").Cells(z1, 13) = "y" Then
Sheets("oard").Cells(z3, s3) = Sheets("FCLM_Data").Cells(z1, 1)
s3 = s3 + 1
ElseIf Sheets("FCLM_Data").Cells(z1, 13) = "p" Then
Sheets("Board").Cells(z4, s4) = Sheets("FCLM_Data").Cells(z1, 1)
s4 = s4 + 1
Else
Sheets("Board").Cells(z2, s2) = Sheets("FCLM_Data").Cells(z1, 1)
s2 = s2 + 1
End If
End If
Next z1
End Sub
Ich habe mir überlegt ob mann auch eine Sperre einbauen kann das bei diesem kopiervorgnag nur eine bestimmte Anzahl kopiert wird wenn diese erreicht ist dann ignorieren und.
If Sheets("FCLM_Data").Cells(z1, 13) = "y" Then ' nur 6 x diesen Kopiervorgang ausführen
Sheets("oard").Cells(z3, s3) = Sheets("FCLM_Data").Cells(z1, 1) s3 = s3 + 1 ElseIf Sheets("FCLM_Data").Cells(z1, 13) = "p" Then ' nur 2x diesen kopiervorgnag ausführen
Sheets("Board").Cells(z4, s4) = Sheets("FCLM_Data").Cells(z1, 1) s4 = s4 + 1
|