Hallo zusammen,
ich habe eine Excel Datei mit verschiedenen Arbeitsblättern.
In einer Spalte habe ich Checkboxen (ActiveX) platziert. Wenn man eine Checkbox anklickt möchte ich, dass der Inhalt der jeweiligen Zeile in der sich die Checkbox befindet in ein anderes Arbeitsblatt (Gesamt) kopiert wird. Dies muss mit mehreren Checkboxen funktionieren, und sobald eine Checkbox wieder geleert (FALSE) wird soll die kopierte Zeile auch wieder auf dem Gesamtblatt gelöscht sein. Weiterhin soll er alle per Checkbox ausgewählten Zeilen immer untereinander kopieren.
Ich habe folgenden Code aber das funktioniert hinten und vorne nicht. Da ich mit VBA keinerlei Erfahrungen habe und nun schon seit Tagen lese aber keine Lösung finde bitte ich hier um Hilfe. Vielleicht kann mir ja jemand helfen.
Vielen Dank
Stoney
Private Sub CheckBox1_Click()
Application.ScreenUpdating = False
If CheckBox1.Value = True Then
Range("A3:R3").Copy 'Zeile kopieren
erste_leere_Zeile = Worksheets("Gesamt"). _
Range("A13").End(xlUp).Offset(1, 0).Row
Worksheets("Gesamt").Cells(erste_leere_Zeile, 1). _
PasteSpecial Paste:=xlPasteFormulas 'kopierte Zeile einfügen
If CheckBox1.Value = False Then
Range("B40000:AA40000").Delete
End If
End Sub
Private Sub CheckBox2_Click()
Application.ScreenUpdating = False
If CheckBox2.Value = True Then
Range("A4:R4").Copy 'Zeile kopieren
erste_leere_Zeile = Worksheets("Gesamt"). _
Range("A13").End(xlUp).Offset(1, 0).Row
Worksheets("Gesamt").Cells(erste_leere_Zeile, 1). _
PasteSpecial Paste:=xlPasteFormulas 'kopierte Zeile einfügen
Range("B40000:AA40000").Delete
End If
End Sub
Private Sub CheckBox3_Click()
Application.ScreenUpdating = False
If CheckBox1.Value = True Then
Range("A5:R5").Copy 'Zeile kopieren
erste_leere_Zeile = Worksheets("Gesamt"). _
Range("A13").End(xlUp).Offset(1, 0).Row
Worksheets("Gesamt").Cells(erste_leere_Zeile, 1). _
PasteSpecial Paste:=xlPasteFormulas 'kopierte Zeile einfügen
Range("B40000:AA40000").Delete
End If
End Sub
Private Sub CheckBox4_Click()
Application.ScreenUpdating = False
If CheckBox1.Value = True Then
Range("A6:R6").Copy 'Zeile kopieren
erste_leere_Zeile = Worksheets("Gesamt"). _
Range("A13").End(xlUp).Offset(1, 0).Row
Worksheets("Gesamt").Cells(erste_leere_Zeile, 1). _
PasteSpecial Paste:=xlPasteFormulas 'kopierte Zeile einfügen
Range("B40000:AA40000").Delete
End If
End Sub
Sub TransferData()
Dim Dst As Worksheet, Src As Worksheet
Dim ch As Object
Dim nRow As Long
Dim Ze As Long
Set Src = Worksheets("Datenquelle")
Set Dst = Worksheets("Gesamt")
With Src
For Each ch In .OLEObjects
With ch
If .progID = "Forms.CheckBox.1" Then
If .Object.Value = True Then
Ze = .TopLeftCell.Row
If Src.Cells(Ze, 7) <> True Then
nRow = Dst.Cells(Rows.Count, 2).End(xlUp).Row + 1
For i = 2 To 6
Dst.Cells(nRow, i - 1) = Src.Cells(Ze, i)
Next i
Src.Cells(Ze, 7) = True
End If
End If
End If
End With
Next
End With
End Sub
|