Makro kopieren

[KevinS]

Hallo zusammen,

ich habe für eine Tabelle (Blatt "Datenbank") ein Makro (mit Hilfe) geschrieben.
Das Makro löscht nach Bestätigung im Pop-Up Feld die gesamte Zeile.
Ich möchte das Makro umschreiben, dass die gewählte Zeile kopiert wird und auf dem Tabellenblatt "Abgelöst" in der letzten Zeile der dortigen Tabelle "Tbl_abgeloest" eingetragen wird.
Zusätzlich soll in der Spalte AI das Datum eingetragen werden, an dem dieses Makro für die jeweilige Zeile ausgeführt wurde.

Anbei das Makro:

Code:

Sub Fahrzeugloeschen()

'Abfrag, ob Fahrzeug wirklich gelöscht werden soll
Dim Antwort

Antwort = MsgBox("Soll das Fahrzeug wirklich gelöscht werden?", vbYesNo + vbQuestion, "Fahrzeug wirklich löschen?")

If Antwort = vbYes Then ActiveCell.EntireRow.Delete

End Sub

Ich hoffe ihr könnt mir helfen. Habe es mit dem Makro aufzeichnen versucht, allerdings ohne Erfolg...

[derHoepp]

Hi,

das Hin- und Herschieben von Datensätzen zwischen Tabellen entspricht im Wesentlichen einer papierbetonten Arbeitsweise. Es empfiehlt sich, gleichartige Daten zusammenzubehalten. Statt des Ausschneidens und Kopierens, solltest du einfach ein zusätzliches Feld "Ausgemustert am:" einfügen. Da muss nichts programmiert werden. Du musst dann einfach ein Datum eintragen und fertig.

Viele Grüße
derHöpp

[KevinS]

Hi,

das Hin- und Herschieben von Datensätzen zwischen Tabellen entspricht im Wesentlichen einer papierbetonten Arbeitsweise. Es empfiehlt sich, gleichartige Daten zusammenzubehalten. Statt des Ausschneidens und Kopierens, solltest du einfach ein zusätzliches Feld "Ausgemustert am:" einfügen. Da muss nichts programmiert werden. Du musst dann einfach ein Datum eintragen und fertig.

Viele Grüße
derHöpp

Gebe ich dir zum Teil recht. Allerdings habe ich mir schon gedanken gemacht, warum ich es so haben möchte wie ich es beschrieben habe.
Hauptgrund ist, dass die Tabelle von einer Mitarbeiterin befüllt wird. Ich möchte es ihr so einfach wie möglich machen.

[26865]

Allerdings habe ich mir schon gedanken gemacht, warum ich es so haben möchte wie ich es beschrieben habe.

Beim "machen" von Gedanken solltest du dann aber auch berücksichtigen, was du selbst lösen kannst. In ein Forum latschen und sich Lösungen auf dem Silbertablett servieren zu lassen, ohne selbst einen Beitrag zu leisten, kann ja ernsthaft keine Lösung sein.

Zudem: Solche Makros gibt es millionenfach im Netz. Wenn du schon selbst nicht auf die Idee kommst, dir das notwendige Wissen anzueignen, solltest du es wenigstens erstmal mit einer Suchmaschine deiner Wahl versuchen.

Und wer es dann nicht mal schafft, seine anderen Themen qualifiziert weiter zu verfolgen, ist ohnehin durchs Raster gefallen, Hilfe zu erwarten. So eine Erwartungshaltung ist daneben.

[derHoepp]

Moin,

ich halte es weiterhin für falsch, ohne ausreichende Programmierkenntnisse so zu tun, als könne man programmieren nur um ein schlechtes Datenmodell aufrecht zu erhalten. Wenn du der Mitarbeiterin eine für Sie intuitivere Arbeitsoberfläche gestalten willst, wäre es deine Aufgabe, Methoden zu entwickeln, die das einheitliche Datenmodell befüllen (wenn es der Mitarbeiterin nicht zuzutrauen ist, einen Datumswert in eine Zelle zu schreiben, sollte dein Code das also einfach übernehmen). Aber sei es drum:
Offensichtlich arbeitest du mit ListObjects (also Tabellen innerhalb von Arbeitsblättern). In diesem Fall solltest du (anders als in deinem bisherigen Code) dringend darauf verzichten, ganze Zeilen zu löschen; das beeinträchtigt nämlich auch eventuell auf dem gleichen Blatt stehende weitere ListObjects. Beschränke dich also in ListObjects auf die ListRows, wenn du diese in der Gesamtheit bearbeiten willst.
Der folgende Code baut darauf auf, dass die Reihenfolge der zu kopierenden Felder zwischen Quelle und Ziel identisch sind. Weitere ListColumns dürfen folgen (müssen sie sogar, sonst könnte das Datum nicht gefüllt werden):

Code:

Option Explicit

Sub moveListRowAndAddTimeStamp()
    If Not Intersect(ActiveCell.EntireRow, ListObjects("tbsource").DataBodyRange) Is Nothing Then
        With ListObjects("tbSource")
            With .ListRows(ActiveCell.Row - .HeaderRowRange.Row)
                Dim lr As ListRow
                Set lr = ListObjects("tbTarget").ListRows.Add()
                .Range.Cut lr.Range
                .Delete
                Intersect(ListObjects("tbTarget").ListColumns("Datum").DataBodyRange, lr.Range) = Date
            End With
        End With
    End If
End Sub

Viele Grüße
derHöpp