Hallo Michael,
bei meinen Vorschlag mußt Du die zwei folgenden Makros austauschen.
Das erste ist der CommandButton2
Code:
Private Sub CommandButton2_Click() ' Club auswählen und Namen eintragen
Dim rngZelle As Range
Dim lngZeile As Long
Dim lngZaehler As Long
Dim lngSpalte As Long
Dim blnVorhanden As Boolean
Dim lngLetzte As Long
'falls ein OptionButton ausgewählt ist
If OptionButton1.Value Xor OptionButton2.Value Then
' Club ausgewählt und Name/Vorname eingetragen
If ComboBox12 <> "" And TextBox1 <> "" And TextBox11 <> "" Then
' Zeile mit Clubname suchen
Set rngZelle = Columns(2).Find(ComboBox12, lookat:=xlWhole, LookIn:=xlValues)
' Clubname gefunden
If Not rngZelle Is Nothing Then
' es sind noch keine Namen eingetragen
If rngZelle.Row + 2 > rngZelle.End(xlDown).Row Then
' Zeile einfügen
Rows(rngZelle.Row + 2).Insert shift:=xlDown
' Name und Vorname in die neue Zeile
rngZelle.Offset(2, -1) = TextBox1
rngZelle.Offset(2, 0) = TextBox11
' Format kopieren und in neue Zeile übertragen
Range(rngZelle.Offset(1, -1), rngZelle.Offset(1, 46)).Copy
rngZelle.Offset(2, -1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
' Füllfarbe zurücksetzen, damit Spalten für Gesamt nicht gelb formatiert sind
Range(rngZelle.Offset(2, -1), rngZelle.Offset(2, 46)).Interior.ColorIndex = xlNone
rngZelle.Offset(1, 43) = 1
Else
' Schleife über alle Namen, die zum betreffenden Club gehören
For lngZaehler = rngZelle.Offset(2, 0).Row To rngZelle.End(xlDown).Row
' Name und Vorname stimmen mit TextBoxen überein
If Cells(lngZaehler, 1) = TextBox1 And Cells(lngZaehler, 2) = TextBox11 Then
' Variable auf True setzen
blnVorhanden = True
' Schleife verlassen
Exit For
End If
Next lngZaehler
' Variable ist True
If blnVorhanden Then
MsgBox "Diesen Spieler gibt es bereits"
Else
' nach dem letzten Spieler eine Zeile einfügen
Rows(rngZelle.End(xlDown).Row + 1).Insert shift:=xlDown
' Name und Vorname in die neue Zeile
Cells(rngZelle.End(xlDown).Row + 1, 1) = TextBox1
Cells(rngZelle.End(xlDown).Row + 1, 2) = TextBox11
' Format kopieren und in neue Zeile übertragen
Range(Cells(lngZaehler - 1, 1), Cells(lngZaehler - 1, 46)).Copy
Cells(lngZaehler, 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
rngZelle.Offset(1, 43) = lngZaehler - rngZelle.Offset(2, 0).Row + 1
End If
End If
'Es muß die Spalte entsprechend dem Geschlecht angegeben werden
If OptionButton1.Value Then
lngSpalte = 7
ElseIf OptionButton2.Value Then
lngSpalte = 13
End If
'und die letzte Zeile entsprechend dem Geschlecht gesucht werden
With Worksheets("Auswertung")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, lngSpalte)), .Cells(.Rows.Count, lngSpalte).End(xlUp).Row, .Rows.Count)
lngLetzte = lngLetzte + 1
.Cells(lngLetzte, lngSpalte) = TextBox1
.Cells(lngLetzte, lngSpalte).Offset(, 1) = TextBox11
.Cells(lngLetzte, lngSpalte).Offset(, 2) = ComboBox12
End With
' TextBoxen und Set-Variable leeren
TextBox1 = ""
TextBox11 = ""
Set rngZelle = Nothing
'die Buttons auf false setzen
OptionButton1.Value = False
OptionButton2.Value = False
ComboBoxenFuellen
End If
Else
MsgBox "Bitte Club auswählen und Namen/Vornamen eintragen"
End If
'falls kein Geschlecht ausgewählt
Else
MsgBox "Das Geschlecht auswählen!"
End If
End Sub
und CommandButton7
Code:
Private Sub CommandButton7_Click()
Dim lngLetzte As Long
If TextBox10 <> "" Then
'Ist die Zelle B4 leer?
With Worksheets("Beispiel")
If .Cells(4, 2) = "" Then
.Cells(4, 2) = TextBox10
.Cells(5, 45) = 0
Else
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
lngLetzte = lngLetzte + 2
.Range("A4:AR5").Copy .Cells(lngLetzte, 1)
.Cells(lngLetzte, 2) = TextBox10
.Cells(lngLetzte, 45).Offset(1, 0) = 0
Application.CutCopyMode = False
End If
End With
'es ist günstiger, die Tabelle Auswertung nach der zweiten If-Abfrage zu befüllen, da nur einmal der Code nötig ist
With Worksheets("Auswertung")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count)
lngLetzte = lngLetzte + 1
.Cells(lngLetzte, 2) = TextBox10
End With
Else
MsgBox "Kein neuer Club eingetragen!"
End If
ComboBoxenFuellen
End Sub
Da bei beiden Makros jeweils nur 2 Codezeilen eingefügt wurden habe ich darauf verzichtet, sie zu kommentieren. Wenn Du die bisherigen mit den neuen vergleichst, findest Du raus, was ich geändert habe. Und das zu verstehen, ist nicht schwer.