vba - doppelte Übertragung verhindern

Question

Hallo Excelfangemeinde,

der nachstehende Code hat mir in der Vergangenheit immer gute Dienste geleistet, aber mittlerweile weiß man, wie man eine zweiter Übertragung des gleichen Tabellenblattes erreichen kann, in dem man die Zelle C3 einfach wieder leer macht.

If Dateiistfrei("G:\Fertigung\Abrechnung zusätzliche Akkordminuten 2010\GrpblattZl.xlsm") = True And Range("c3") = "" Then
UserForm1.Show

Frage: Wie fangt ihr eine doppelte Übertragung ab - sprich, wie kann die vorhandene Abfrage erweitert werden, ohne das ein Dritter anschließend nach der ersten erfolgten Übertragung der Daten diese noch mal übertragen kann?

Für Anregungen oder Lösungen bedanke ich mich schon mal im Voraus und verbleibe mit freundlichen Grüßen und mit einem have a nice Evening...   Helmut

Answer 1

Hallo Helmut,

ganz wirst du die doppelten Übertragungen nicht verhindern können. Aber versuchs mal mit Sperren von C3 nach Eingabe per Makro mit ActiveSheet.Protect "Passwort". Sodass ein Löschen nicht mehr möglich ist.

Wie wird denn C3 gefüllt. Ebenfalls per Code oder von Hand?

Gruß Mr. K.

Answer 2

Hallo Mr. K.,

bin leider erst jetzt wieder dazu gekommen mir Deine Antwort anzuschauen. Zunächst einmal vielen Dank fürs reinschauen.

Ich fülle die Zelle C3 mittels Makro, das im Anschluss an das obige folgt - sprich in der Userform1 gestartet wird.

In Zelle C3 füge ich mit NOW() Datum und Uhrzeit ein, damit ich weiß, wann die Übergabe der Daten stattgefunden hat.

Da ich das gerade nochmal nachgespielt haben, habe ich mich gefragt, warum kann man das eigentlich löschen, wenn der Blattschutz doch schon mal da ist... und somit habe ich mir selber die Antwort gegeben... Zellschutz drauflegen und danach den Blattschutz und keiner kann mehr die Zelle C3 anpacken...

Ist wieder das Phänomen, dass wenn man jemanden sein Problem und Vorgehensweise erklärt, dann selber auf die Lösung kommt.

Nochmals vielen Dank fürs reinschauen und Deiner Anfrage, die mich nun selber auf die einfache Lösung gebracht hat. - sehe gerade beim Lesen Deiner Antwort, dass Du mir ja auch schon dazu geraten hattest... oh Mann.. habe ich gerade erst registriert...  Thx...

In diesem Sinne... have a nice Day und auch an alle Interessierten...  LG Helmut

   ActiveSheet.Unprotect "xxx"

Range("c3").Select
    ActiveCell.FormulaR1C1 = "=NOW()"
    Range("c3").Select
    Selection.Interior.ColorIndex = 36
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, operation:= _
        xlNone, skipblanks:=False, Transpose:=False