ich stosse grad mit meinen bescheidenen VBA-Kenntnissen an meine Grenzen. Ich habe folgendes vor.
Es gibt eine Dateivorlage "Blanco.xlsm".
Diese wird unter neuen Dateinamen abgespeichert (z.B. West.xlsm, Sued.xlsm, Nord.xlsm, Mitte.xlsm) und mit Daten gefüllt. Am Ende eines Kalenderjahres soll diese Datei archiviert werden. Hierbei soll der bisherige Dateiname (z.B. West.xlsm) mit einem Unterstrich und der Jahreszahl ergänzt werden (West_2015.xlsm) und in dem Ordner "Archiv" abgelegt werden, welcher sich in demselben Verzeichnis wie die zu archivierenden Dateien befindet. Die Jahreszahl wird aus der Zelle C1 geholt. Dort liegt sie im Format TT.MM.JJJJ vor.
Anschließend sollen die eingegebenen Daten aus der Originaldatei (West.xlsm) entfernt werden. Zum entfernen der Daten habe ich schon ein Makro.
Jetzt meine Frage. Ist es möglich das Makro in der Vorlage (Blanco.xlsm) dahingehend zu ergänzen, dass vor dem entfernen der Daten eine wie vor beschriebene Archivdatei erstellt wird?
Abfrage Datei archiviert = ja - Überschreiben der Archivdatei (ohne Nachfrage)
Abfrage Datei archiviert = nein - Erzeugen der Archivdatei (ohne Nachfrage)
Besten Dank für eure Hilfe,
Thomas
Hier noch mein Makro zum entfernen der Daten.
Sub Tabelle_leeren()
If MsgBox("Ist diese Datei archiviert?", vbQuestion + vbYesNo, _
"Datei archiviert?") = vbYes Then
If MsgBox("Das Löschen der Daten kann nicht wiederrufen werden." _
& Chr(10) & "Wirklich löschen?", vbQuestion + vbYesNo, _
"Löschen bestätigen") = vbYes Then
Application.ScreenUpdating = False
Range("B4:D63,F4:N63,Q4:S63,V4:Z63,C1,F1:H1,K1:M1").Select
Selection.ClearContents
Range("AA4:AA63").Select
ActiveWorkbook.Worksheets("Auflistung").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Auflistung").Sort.SortFields.Add Key:=Range _
("AA4:AA63"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Auflistung").Sort
.SetRange Range("AA4:AA63")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End If
End If
Range("B65536").End(xlUp).Offset(1, 0).Select
End Sub