Checkbox aktiviert Zeile kopieren und löschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallöchen,

hier mal ein Ansatz für die Vorgehensweise:

Sub Makro1()

    ActiveSheet.Range("$A$1:$L$31").AutoFilter Field:=12, Criteria1:=">"

    With Range("$A$2:$L$31").SpecialCells(xlCellTypeVisible)

      .Copy Sheets("Tabelle2").Range("A2")

      .Delete

    End With

End Sub

Hinweise:
- Du solltest prüfen, ob im Bereich auch ein x vorhanden ist, ansonsten bekommst Du eine Fehlermeldung. Kann man natürlich auch programmieren.
- der code löscht die ganze Blattzeile. Wenn das ok ist, kann man auch die Meldung unterdrücken. Wenn nicht, muss man beim Löschen anders vorgehen.
- der Code fügt immer in A2 ein, egal, ob dort schon was steht. Wenn Du die alten Daten behalten willst, müsste man die erste freie Zelle programmieren.
- der Code fügt immer in A2 ein, egal, ob dort schon was steht. Wenn Du die alten Daten überschreiben willst, sollte man sie besser löschen - es könnten mehr sein als die neuen.

Sub Makro2() ActiveSheet.Range("$A$1:$L$31").AutoFilter Field:=12, Criteria1:=">" With Range("$A$2:$L$31").SpecialCells(xlCellTypeVisible) .Copy Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Offset(1) .Delete End With End Sub

Sub Makro2() ActiveSheet.Range("$A$1:$L$31").AutoFilter Field:=12, Criteria1:="x" With Range("$A$5:$L$31").SpecialCells(xlCellTypeVisible) .Copy Sheets("Produziert").Cells(Rows.Count, 1).End(xlUp).Offset(1) .Delete End With End Sub

Sub Makro2() With ActiveSheet.Columns(12) If WorksheetFunction.CountIf(.Cells, "x") > 0 Then .Replace "x", True With .SpecialCells(xlCellTypeConstants, 4) .Value = "x" .EntireRow.Copy Sheets("Produziert").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) .EntireRow.Delete End With End If End With End Sub

Sub Makro4() With ActiveSheet.ListObjects("Tabelle1") If WorksheetFunction.Count(.ListColumns(12).DataBodyRange, "x") > 0 Then .Range.AutoFilter Field:=12, Criteria1:="x" With .DataBodyRange.SpecialCells(xlCellTypeVisible) .Copy Sheets("Produziert").Cells(Rows.Count, 1).End(xlUp).Offset(1) .Delete End With Else MsgBox "Nix x gefunden" End If End With End Sub

Beliebteste Forumthreads (12 Monate)

Checkbox aktiviert Zeile kopieren und löschen

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Checkbox aktiviert Zeile kopieren und löschen

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread