Ich habe eine Userform mit 4 Checkboxen (at1350s,dd45s,hda300,einstecks) und einen CommandButton. Ich möchte dass das Programm mehrere Bedingungen durchgeht. Hier mein Programm:
Private Sub CommandButton1_Click()
''__Sprachaudiometrie__
Dim Zeile1
Dim Zeile2
Dim tausch1
Dim tausch2
Dim Quelltab As Worksheet
Dim Zieltab As Worksheet
'Kombi 1: Nur At1350
If Me.at1350s Then
''Überschrit
Range("A185").Formula = "AT1350"
With Range("A185")
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = True
End With
''Gc-GF Werte
Zeile1 = 188 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "C153:C159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch1 In Quelltab.Range("C153:C159")
Zieltab.Cells(Zeile1, 6) = tausch1
Zeile1 = Zeile1 + 1
Next tausch1
''Tabelle 2 löschen
Range("A198:K211").EntireRow.Delete
''Kombi 2: Nur DD45
ElseIf Me.dd45s Then
''Überschrit
Range("A185").Formula = "DD45"
With Range("A185")
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = True
End With
''Gc-GF Werte
Zeile1 = 188 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "B153:B159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch1 In Quelltab.Range("B153:B159")
Zieltab.Cells(Zeile1, 6) = tausch1
Zeile1 = Zeile1 + 1
Next tausch1
''Tabelle 2 löschen
Range("A198:K211").EntireRow.Delete
''Kombi 3: Nur Einsteck
ElseIf Me.einstecks Then
''Überschrit
Range("A185").Formula = "Einsteckhörer"
With Range("A185")
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = True
End With
''Gc-GF Werte
Zeile1 = 188 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "E153:E159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch1 In Quelltab.Range("E153:E159")
Zieltab.Cells(Zeile1, 6) = tausch1
Zeile1 = Zeile1 + 1
Next tausch1
''Tabelle 2 löschen
Range("A198:K211").EntireRow.Delete
''Kombi 4: Nur HDA300
ElseIf Me.einstecks Then
''Überschrit
Range("A185").Formula = "HDA300"
With Range("A185")
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = True
End With
''Gc-GF Werte
Zeile1 = 188 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "D153:D159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch1 In Quelltab.Range("D153:D159")
Zieltab.Cells(Zeile1, 6) = tausch1
Zeile1 = Zeile1 + 1
Next tausch1
''Tabelle 2 löschen
Range("A198:K211").EntireRow.Delete
''Kombi 5: AT1350 und DD45
ElseIf Me.at1350s And Me.dd45s Then
''Überschrit
Range("A185").Formula = "AT1350"
Range("A200").Formula = "DD45"
With Range("A185,A200")
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = True
End With
Zeile1 = 188 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "C153:C159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch1 In Quelltab.Range("C153:C159")
Zieltab.Cells(Zeile1, 6) = tausch1
Zeile1 = Zeile1 + 1
Next tausch1
Zeile2 = 203 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "B153:B159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch2 In Quelltab.Range("B153:B159")
Zieltab.Cells(Zeile2, 6) = tausch2
Zeile2 = Zeile2 + 1
Next tausch2
''Kombi 6: AT1350 und Einsteck
ElseIf Me.at1350s And Me.einstecks Then
''Überschrit
Range("A185").Formula = "AT1350"
Range("A200").Formula = "Einsteckhörer"
With Range("A185,A200")
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = True
End With
Zeile1 = 188 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "C153:C159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch1 In Quelltab.Range("C153:C159")
Zieltab.Cells(Zeile1, 6) = tausch1
Zeile1 = Zeile1 + 1
Next tausch1
Zeile2 = 203 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "E153:E159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch2 In Quelltab.Range("E153:E159")
Zieltab.Cells(Zeile2, 6) = tausch2
Zeile2 = Zeile2 + 1
Next tausch2
'Kombi 7: AT1350 und HDA300
ElseIf Me.at1350s And Me.hda300s Then
''Überschrit
Range("A185").Formula = "AT1350"
Range("A200").Formula = "HDA300"
With Range("A185,A200")
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = True
End With
Zeile1 = 188 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "C153:C159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch1 In Quelltab.Range("C153:C159")
Zieltab.Cells(Zeile1, 6) = tausch1
Zeile1 = Zeile1 + 1
Next tausch1
Zeile2 = 203 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "D153:D159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch2 In Quelltab.Range("D153:D159")
Zieltab.Cells(Zeile2, 6) = tausch2
Zeile2 = Zeile2 + 1
Next tausch2
'Kombi 8: Einsteck und DD45
ElseIf Me.einstecks And Me.dd45s Then
''Überschrit
Range("A185").Formula = "Einsteckhörer"
Range("A200").Formula = "DD45"
With Range("A185,A200")
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = True
End With
Zeile1 = 188 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "E153:E159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch1 In Quelltab.Range("E153:E159")
Zieltab.Cells(Zeile1, 6) = tausch1
Zeile1 = Zeile1 + 1
Next tausch1
Zeile2 = 203 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "B153:B159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch2 In Quelltab.Range("B153:B159")
Zieltab.Cells(Zeile2, 6) = tausch2
Zeile2 = Zeile2 + 1
Next tausch2
'Kombi 9: HDA300 und DD45
ElseIf Me.hda300s And Me.dd45s Then
''Überschrit
Range("A185").Formula = "HDA300"
Range("A200").Formula = "DD45"
With Range("A185,A200")
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = True
End With
Zeile1 = 188 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "D153:D159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch1 In Quelltab.Range("D153:D159")
Zieltab.Cells(Zeile1, 6) = tausch1
Zeile1 = Zeile1 + 1
Next tausch1
Zeile2 = 203 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "B153:B159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch2 In Quelltab.Range("B153:B159")
Zieltab.Cells(Zeile2, 6) = tausch2
Zeile2 = Zeile2 + 1
Next tausch2
'Kombi 10: HDA300 und Einsteck
ElseIf Me.hda300s And Me.einstecks Then
''Überschrit
Range("A185").Formula = "HDA300"
Range("A200").Formula = "Einsteckhörer"
With Range("A185,A200")
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = True
End With
Zeile1 = 188 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "D153:D159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch1 In Quelltab.Range("D153:D159")
Zieltab.Cells(Zeile1, 6) = tausch1
Zeile1 = Zeile1 + 1
Next tausch1
Zeile2 = 203 ''ab welcher Zeile die Werte eingefügt werden
Bereich = "E153:E159"
Set Quelltab = ActiveWorkbook.Worksheets("MP1")
Set Zieltab = ActiveWorkbook.Worksheets("AT1000")
For Each tausch2 In Quelltab.Range("E153:E159")
Zieltab.Cells(Zeile2, 6) = tausch2
Zeile2 = Zeile2 + 1
Next tausch2
'Kombi 11: Keine Sprachaudiometrie
Dim Auswahl As Boolean
Auswahl = Auswahl Or hda300s
Auswahl = Auswahl Or einstecks
Auswahl = Auswahl Or dd45s
Auswahl = Auswahl Or at1350s
ElseIf Not Auswahl Then
Range("A166:K219").EntireRow.Delete
End If
Unload Me
End Sub
Das Problem ist, dass wenn ich AT1350 UND z.B. DD45 auswähle, nur die erste Anweisung ausgelöst wird. Das heißt Nur AT1350 und DD45 ignoriert er. Die Tabelle für AT1350 wird ausgefüllt und für DD45 nicht. Könnt ihr mir da weiterhelfen?
lg Jasmin