Teilnehmer mehrfach in Reihe untereinanderstellen nach Angabewert

[WergibtmirRat]

Hallo @all

wie kann es anders sein, es betrifft meine Kegeltabelle

Zur Zeit fülle ich die Teilnehmerliste nach jedem Durchgang per Commandbutton
Zum Problem: Wie ist die Teilnehmerliste mehrfach, je nach Runden, in eine Spalte untereinander zu bringen.
anbei Beispieldatei:

  CEF_Beispieldatei2014_11.xlsx (Größe: 13,25 KB / Downloads: 14)

Habe es schon mit Formeln versucht laufe aber meist in einen Zirkelbezug hinein

Maxanzahl minus Zählenwenn = wenn zählenwenn kleiner dann erhöhe um 1, so in etwa

mfg

[Steffl]

Hallo Frank,

meinst Du so? (Eingetragen wird am der Zelle M19 und die Anzahl habe ich aus der Zelle P13 genommen)

Code:

Private Sub CommandButton1_Click()
   Dim rngBereich As Range
  
   Set rngBereich = Range(Cells(3, 13), Cells(3, 13).End(xlDown))
   rngBereich.Copy Range("M19")
   Range("M19").Resize(rngBereich.Rows.Count).AutoFill Range("M19").Resize(rngBereich.Rows.Count * Range("P13"))

End Sub

[WergibtmirRat]

...meinst Du so...

Jeeeeeeep
Hallo Stefan, ja
That'z it

nun kann ich nach tagelangem Stöbern/probieren wieder in Ruhe einen Spätburgunder geniessen

vielen Dank

[WergibtmirRat]

Kleiner Schönheitsfehler

Bei einer 1 z.b. "Bingo" wird der Fehler "400" ausgegeben, ohne weitere Marke und Text.

Kann man das eventuell mit Msgbox oder Errormeldung umgehen, abfangen.

[Steffl]

Hallo Frank,

mal ohne Msgbox bzw Errormeldung

Code:

Private Sub CommandButton1_Click()
   Dim rngBereich As Range
  
   Set rngBereich = Range(Cells(3, 13), Cells(3, 13).End(xlDown))
   rngBereich.Copy Range("M19")
   If Range("P13").Value > 1 Then Range("M19").Resize(rngBereich.Rows.Count).AutoFill Range("M19").Resize(rngBereich.Rows.Count * Range("P13"))

End Sub

[WergibtmirRat]

Code:

Private Sub CommandButton1_Click()
   Dim rngBereich As Range  
   Set rngBereich = Range(Cells(3, 13), Cells(3, 13).End(xlDown))
   rngBereich.Copy Range("M19")
   If Range("P13").Value > 1 Then Range("M19").Resize(rngBereich.Rows.Count).AutoFill Range("M19").Resize(rngBereich.Rows.Count * Range("P13"))
End Sub

Hallo Stefan & @all, kann man den Code auch auf ein Tabellenblatt herrichten.
z.b.

PHP-Code:

Set rngBereich = Workshett("Tabelle1").Range(Cells(3, 13), Cells(3, 13).End(xlDown)) 


bei mir passiert da garnichts.

mfg

[WergibtmirRat]

Code:

Private Sub CommandButton1_Click()
   Dim rngBereich As Range  
   Set rngBereich = Range(Cells(3, 13), Cells(3, 13).End(xlDown))
   rngBereich.Copy Range("M19")
   If Range("P13").Value > 1 Then Range("M19").Resize(rngBereich.Rows.Count).AutoFill Range("M19").Resize(rngBereich.Rows.Count * Range("P13"))
End Sub

Hallo Stefan & @all, kann man den Code auch auf ein Tabellenblatt herrichten.
z.b.

PHP-Code:

Set rngBereich = Workshett("Tabelle1").Range(Cells(3, 13), Cells(3, 13).End(xlDown)) 


bei mir passiert da garnichts.
Edit:
Fehler gefunden: Worksheets
Edit End:

mfg

[Steffl]

Hallo Frank,

Hallo Stefan & @all, kann man den Code auch auf ein Tabellenblatt herrichten.
z.b.

PHP-Code:

Set rngBereich = Workshett("Tabelle1").Range(Cells(3, 13), Cells(3, 13).End(xlDown)) 


bei mir passiert da garnichts.
Edit:
Fehler gefunden: Worksheets
Edit End:

Fast. Du mußt auch vor den Cells das Tabellenblatt mit angeben bzw mit With .... arbeiten

Code:

With Worksheets("Tabelle1")
   Set rngBereich = .Range(.Cells(3, 13), .Cells(3, 13).End(xlDown))
End With

[WergibtmirRat]

...Fast...

Hallo Stefan & @all

Danke für den Tipp
anbei meine kleine Probetabelle

  CEF-Beispiel_14_11_17.xlsm (Größe: 24,37 KB / Downloads: 3)

Code:

'Anwendung benutzen:
'1. Combobox1 Wert wählen
'2. Commandbutton1 wählen
' fertig dann Commandbutton2
'Man benötigt eine Userform hier die 1
'zudem 2 Commandbutton
' und ein Combofeld
' im Tabellenblatt "Tabelle1" in Spalte A die feste Liste
' eine Datenüberprüfung von (z.b.) "Tabelle1" - "M3:M15" mit Namen "Teilnehmer" erstellen
' die Artliste (z.b.) "Tabelle1" - "C2:C7" erstellen
' ab D2 den Wiederholungswert bis D7 eintragen
' diese Formel im Tabellenblatt "Tabelle1" - "P13" eintragen =WENNFEHLER(SVERWEIS(Q13;C2:D7;2;0);"")
' eine Schaltfläche auf das Tabellenblatt legen
'#######################################
' unter diese Arbeitsmappe die nächsten Zeilen
'#######################################
'Option Explicit
'Private Sub Workbook_Open()
'UserForm1.Show vbModeless
'End Sub
'#######################################
' unter Userform1 die nächsten Zeilen
'#######################################
Option Explicit
Private Sub ComboBox1_Change()
    Makro1
    Worksheets("Tabelle1").Range("Q13") = ComboBox1
End Sub
Private Sub CommandButton1_Click()
   Dim rngBereich As Range
    With Worksheets("Tabelle1")           'wo sind die zu wählenden Informationen
       Set rngBereich = Range(Cells(3, 13), Cells(3, 13).End(xlDown))
       rngBereich.Copy Range("M19")       'hier beginnt die Eingabe der Auswahl mit Mehrfachstellung
                                          'der Wert in P13 wird als Vervielfältigungswert übergeben
       If Range("P13").Value > 1 Then Range("M19").Resize(rngBereich.Rows.Count).AutoFill Range("M19").Resize(rngBereich.Rows.Count * Range("P13"))
    End With
End Sub
Private Sub CommandButton2_Click()
    Unload Me                             'schließt das Formular
End Sub
'#######################################
' unter Modul die nächsten Zeilen
'#######################################
Option Explicit
Sub Makro1()
    Range("M19:M500").Select              'den zu löschenden Tabellenbereich markern
    Selection.ClearContents               'löscht die vorherige Auswahl
End Sub
Sub Schaltfläche2_KlickenSieAuf()
    UserForm1.Show vbModeless             'zeigt das Formular an und lässt mich im Tabellenblatt agieren
End Sub

für weitere Vorschläge immer offen

have fun

[Steffl]

Hallo Frank,

eine Frage zu diesem Code

PHP-Code:

Private Sub CommandButton1_Click()
   Dim rngBereich As Range
    With Worksheets("Tabelle1")           'wo sind die zu wählenden Informationen
       Set rngBereich = Range(Cells(3, 13), Cells(3, 13).End(xlDown))
       rngBereich.Copy Range("M19")       'hier beginnt die Eingabe der Auswahl mit Mehrfachstellung
                                          'der Wert in P13 wird als Vervielfältigungswert übergeben
       If Range("P13").Value > 1 Then Range("M19").Resize(rngBereich.Rows.Count).AutoFill Range("M19").Resize(rngBereich.Rows.Count * Range("P13"))
    End With
End Sub 


wieso verwendest Du hier With wenn du vor Cells und Range keine Punkte setzt? Wobei ich würde korrekt auf das Tabellenblatt verweisen (eben mit With bzw. die Angabe des Worksheets).