Office: (Office 2010) Excel Datei mit fortlaufender Nummer, Originaldatei belassen, nur speichern unter

Hallo,

ich habe eine Excel-Datei, wo eine Zelle sich beim Speichern und wieder öffnen sich um 1 erhöht.
Dafür habe ich diesen Code benutzt.

Private Sub Workbook_Open()
With Sheets("Tabelle1")
.Range("H5") = .Range("H5") + 1
End With
End Sub

Mein Wunsch wäre nun, das ausgefüllte Arbeitsblatt mit speichern unter abzuspeichern, so dass die Originaldatei bestehen bleibt
und sich die Zelle H5 beim nächsten öffnen um 1 erhöht.
Wenn es hierzu noch die Möglichkeit gebe, den Dateinamen anhand der Zelle H5 mit "WA" davor automatisch zu speichern, wäre perfekt.

Besten Dank im voraus!

 

Hi,

dazu verwendet man den Befehl SaveCopyAs:

Code:

    ThisWorkbook.SaveCopyAs "E:\Z_Test\WA" & Worksheets("Tabelle1").Range("H5") & ".xlsm"

Der Speicherpfad muss dabei natürlich ebenfalls angegeben werden.

Bis später,
Karin

 

Hallo Karin,

danke für die schnelle Antwort.
Ich habe den Befehl wie folgt geändert:
Private Sub Workbook_Open()
With Sheets("Tabelle1")
.Range("H5") = .Range("H5") + 1
ThisWorkbook.SaveCopyAs "D:\Test\WA" & Worksheets("Tabelle1").Range("H5") & ".xlsm"
End With
End Sub

Beim Schließen der Datei wird die Tabelle im angegebenen Pfad gespeichert, wen ich diese gespeicherte Datei
öffne erhalte ich die Originaldatei (jedoch unausgefüllt) mit der nächsten Nummer.
Das nächste Problem ist, da ich die Originaldatei nicht speichere (soll nur eine Vorlage sein) wird beim
nochmaligen öffnen der Datei keine neue Nummer generiert.

 

Hallo Karin,

vielen Dank für die schnelle Antwort.
Ich habe den Befehl wie folgt geändert:

Private Sub Workbook_Open()
With Sheets("Tabelle1")
.Range("H5") = .Range("H5") + 1
ThisWorkbook.SaveCopyAs "D:\Test\WA" & Worksheets("Tabelle1").Range("H5") & ".xlsm"
End With
End Sub

Die Datei wird jetzt auch im angegeben Pfad gespeichert, wenn ich diese wider öffne
erhalte ich jedoch nur die Originaldatei (nicht die ausgefüllte Vorlage) mit der nächsten Nummer.
Da ich die Originaldatei nicht speichern kann (Mustervorlage) wird beim nächsten öffnen
der Datei keine neue Nummer generiert.
Wie kann ich diese Probleme lösen!
Eine kompletter Befehl wäre sehr hilfreich!

Besten Dank im voraus

 

Hi,

wenn du die Originalmappe schließt, musst du sie natürlich speichern, sodass die Änderung in H5 wirksam bleibt - dann wird beim erneuten Öffnen auch die nächste Nummer vergeben.

Der Ablauf müsste also folgender sein:

1. Öffnen der "Vorlage" und Erhöhen der Zahl in H5
2. Speichern der "Vorlage"
3. SaveCopyAs der Vorlage in einer neuen Mappe
4. Entragen von Daten in der neuen Mappe
5. irgendwann Speichern und Schließen der neuen Mappe

Dann kann der Prozess wieder von vorn beginnen.

Bis später,
Karin

 

Hallo Karin,

habe den Befehl wie folgt geändert:
Private Sub Workbook_Open()
With Sheets("Tabelle1")
.Range("J5") = .Range("J5") + 1
ThisWorkbook.Save
ThisWorkbook.SaveCopyAs "D:\Test\WA2018_" & Worksheets("Tabelle1").Range("J5") & ".xlsm"
End With
End Sub

Das speichern der Originaldatei klappt.
Somit wird beim erneuten öffnen der Wert erhöht.
Nur wenn ich die Kopie öffne wird der Wert der Zelle J5 auch wieder erhöht.

 

Hi,

hast du außer dem Code im Workbook_Open noch weiteren Code in der Arbeitsmappe? Falls nicht, dann speichere sie doch einfach als xlsx-Datei - dabei wird jeglicher vorhandener Code gelöscht.

Bis später,
Karin

 

Hi,

in der Arbeitsmappe befindet sich kein weiterer Code.
Wenn ich die Kopie in xlsx speichere kann er diese nicht öffnen, da das Dateiformat
bzw. die Dateierweiterung ungültig ist.
Ich habe mir schon überlegt, vor dem Befehl "SaveCopyAS" den Code zu löschen -
finde aber keinen.

 

Hi,

zeichne doch einfach mal den Code mit dem Makrorekorder auf, wenn du die Arbeitsmappe im xlsx-Format speicherst.

Bis später,
Karin

 

Danke super, mit dem Rekorder hat alles geklappt.

Nur noch eins, gibt es eine Möglichkeit nachfolgende Meldung mit einem Code automatisch zu bejahen.


Hier der bestehende Code:

Private Sub Workbook_Open()
Sheets("Tabelle1").Select
ActiveSheet.Unprotect
With Sheets("Tabelle1")
.Range("J5") = .Range("J5") + 1
ActiveWorkbook.Save
ChDir "P:\Werkstattaufträge\2018"
ActiveWorkbook.SaveAs Filename:="P:\Werkstattaufträge\2018\WS2018_" & Worksheets("Tabelle1").Range("J5") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Sheets("Tabelle1").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=suli_

End With
End Sub

 

Hi,

also in deinem Code ist ein Kompilierungsfehler - da fehlt offensichtlich ein Teil der Codezeile (habe den Teil markiert).

Du kannst versuchen, die Meldungen zu unterdrücken, wenn du DisplayAlerts ausschaltest - nach diesem Prinzip (ungetestet):

Code:

Private Sub Workbook_Open()
    [COLOR=#008000]Application.DisplayAlerts = False[/COLOR]
    With ThisWorkbook.Worksheets("Tabelle1")
        .Unprotect
        .Range("J5") = .Range("J5") + 1
        .Save
        ChDir "P:\Werkstattaufträge\2018"
        .SaveAs Filename:="P:\Werkstattaufträge\2018\WS2018_" & .Range("J5") & ".xlsx" _
            , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        .Protect DrawingObjects:=False, Contents:=True, Scenarios:=suli_  '[COLOR=#ff0000][B]<==Kompilierungsfehler!!![/B][/COLOR]
    End With
    [COLOR=#008000]Application.DisplayAlerts = True[/COLOR]
End Sub

Bis später,
Karin