Zeilen nach ausgewählten Kontrollkästchen kopieren
14.11.2015 11:43:31
Kaomoji
Ich bin VBA Anfänger und kämpfe momentan mit einen Makro, das ich hier im Forum gefunden und abgewandelt habe und fast schon perfekt ist.
Situation: in Tabelleblatt1 sind Daten, die durch ein Kontrollkästchen ausgewählt werden können. Via Button werden diese ausgewählten Zeilen dann in Tabelleblatt2 in die erste freie Zeile kopiert. Das funktioniert einwandfrei.
Nun möchte ich aber aus den ausgewählten Zeilen nur Spalte C und D, nicht aber Spalte B (wo die Kontrollkästchen sind) und Spalte A (wo unnötige Daten stehen) kopieren. Die Daten aus Spalte C und D sind im Zieltabellenblatt dann Spalte A und B. Wichtig dabei ist, dass im Zieltabelleblatt bereits vorhandene Formeln in Spalte F nicht überschrieben werden.
nachfolgendes Makro möchte ich ensprechend ändern (Credits an denjenigen, der es geschrieben _ hat - Ich habe leider den Namen vergessen, sorry):
Sub ZeilenKopieren()
Dim wksQuelle As Worksheet, objShapeQuelle As Shape, wksZiel As Worksheet, objShape As Shape
Dim rngQuelle As Range, lngZeileLetzte As Long
'Sicherheitsabfrage
If MsgBox("Zeilen kopieren?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Set wksQuelle = Worksheets("Tabelle1")
Set wksZiel = Worksheets("Tebelle2")
For Each objShapeQuelle In wksQuelle.Shapes
If objShapeQuelle.Type = msoFormControl Then
If objShapeQuelle.FormControlType = xlCheckBox Then
If objShapeQuelle.ControlFormat.Value = 1 Then
'Linke obere Zelle des Kontrollkästchens einem Range-Object zuweisen
'Diese Zelle ist der Bezugspunkt für die Kopieraktionen
Set rngQuelle = objShapeQuelle.TopLeftCell
With wksZiel
'letzte Zeile mit Daten in Spalte A der Zieltabelle ermitteln
lngZeileLetzte = .Cells(.Rows.Count, 3).End(xlUp).Row
'Zeile aus Quelle nach Ziel kopieren
wksQuelle.Rows(rngQuelle.Row).Copy Destination:=.Cells(lngZeileLetzte + 1, 1)
'kopiertes Kontrollkästchen im Ziel löschen
.Shapes(.Shapes.Count).Delete
End With
End If
End If
End If
Next
End Sub
Vielen lieben Dank!
LG
Kaomoji