Hallo liebes VBA-Forum,
da VBA für mich absolutes Neuland ist, brauche ich mal eure Hilfe.
Ich benötige den Befehl für ein Makro, welches sobald eine Zelle einen bestimmten Wert ausgibt, die gesamte Spalte auf ein zweites Tabellenblatt verschiebt und auf dem ersten den verschobenen Inhalt löscht. Hierbei soll beim Kopieren und Löschen die Spalte A unberührt bleiben, da diese eine Formel enthält.
Bei stundenlanger Onlinerecherche bin ich bisher zu folgendem Code gekommen:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zeile As Long
Set Target = Intersect(Target, Range("A1:A1000"))
If Target Is Nothing Then Exit Sub
If Target = "Verschieben" Then
Zeile = Target.Row
Range(Cells(Zeile, 2), Cells(Zeile, 50)).Copy _
Destination:=Sheets("Laufende Bewerbungen").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Zeile = Target.Row
Range(Cells(Zeile, 2), Cells(Zeile, 50)).ClearContents
End If
End Sub
Diesen hatte ich zunächst im Code des Tabellenblattes was auch grundsätzlich funktionierte, allerdings kopiert er die Zeile immer in die erste Spalte des zweiten Tabellenblattes("Laufende Bewerbungen") und überschreibt diese dann mit weiteren Kopien aus Tabellenblatt 1(Tägliche Bewerbungen), anstatt dies fortlaufend untereinander zu schreiben, wie es erwünscht wäre.
Auf dem zweiten Tabellenblatt ("Laufende Bewerbungen") läuft der Code in ähnlicher Ausführung ( einziger Unterschied: 3 if Möglichkeiten) , wobei dasselbe Problem des Überschreibens auftritt, außer beim Verschieben von Tabellenblatt " Laufende Bewerbungen" auf das Tabellenblatt " Absagen". Hier klappt das so wie es gewünscht ist, obwohl der Befehl in seiner Form identisch mit den anderen ist.
Hier noch der Code der in dem Tabellenblatt "Laufende Bewerbungen angewendet wird:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zeile As Long
Set Target = Intersect(Target, Range("A1:A1000"))
If Target Is Nothing Then Exit Sub
If Target = "Verschieben" Then
Zeile = Target.Row
Range(Cells(Zeile, 2), Cells(Zeile, 50)).Copy _
Destination:=Sheets("Ältere Bewerbungen").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Zeile = Target.Row
Range(Cells(Zeile, 2), Cells(Zeile, 50)).ClearContents
ElseIf Target = "Bewerberpool" Then
Zeile = Target.Row
Range(Cells(Zeile, 2), Cells(Zeile, 50)).Copy _
Destination:=Sheets("Bewerberpool").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Zeile = Target.Row
Range(Cells(Zeile, 2), Cells(Zeile, 50)).ClearContents
ElseIf Target = "Absagen" Then
Zeile = Target.Row
Range(Cells(Zeile, 2), Cells(Zeile, 50)).Copy _
Destination:=Sheets("Absagen").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Zeile = Target.Row
Range(Cells(Zeile, 2), Cells(Zeile, 50)).ClearContents
End If
End Sub
Die Struktur ist auf allen Tabellenblättern exakt gleich.
Die Ausgabe der Bedingung in den Spalten A erfolgt anhand einer Formel.
Weiterhin wollte ich dieses Code gerne per Button abrufen und nicht mehr in den Code des Tabellenblattes schreiben.
Dies habe ich für den ersten Code so probiert:
Sub Schaltfläche61_Klicken()
Dim Zeile As Long
Set Target = Intersect(Target, Range("A1:A1000"))
If Target Is Nothing Then Exit Sub
If Target = "Verschieben" Then
Zeile = Target.Row
Range(Cells(Zeile, 2), Cells(Zeile, 50)).Copy _
Destination:=Sheets("Laufende Bewerbungen").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Zeile = Target.Row
Range(Cells(Zeile, 2), Cells(Zeile, 50)).ClearContents
End If
End Sub
Allerdings erhalte ich so den Fehler 424: Objekt erforderlich mit dem Hinweis auf die Zeile Set Target = Intersect(Target, Range("A1:A1000"))
Ich hoffe jemand kann mir hier helfen. Sollte noch irgendwas unklar geblieben sein oder eine Beispieldatei erwünscht sein, kann ich das gerne nachreichen.
Danke bereits im Vorraus! :D
|