Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1704to1708
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Sicherungskopie

Sicherungskopie
03.08.2019 13:23:55
Stephan
Hallo Zusammen,
ich habe eine Datei von der ich gerne eine Sicherungskopie erstellen möchte. Die Sicherungskopie soll im gleichen Pfad gespeichert werden. In der Sicherungskopie sollen alle Makros entfernt sein, die Formeln sollen nur als Werte angezeigt werden und es gibt einige Tabellenblätter, die ich gerne löschen möchte - auch ausgblendete.
Schön wäre es alles in einem zusammen in einem Makro zu haben.
Für die Sicherungskopie verwende ich bisher. Allerdings arbeite ich dann in der Originaldatei weiter.
Grüße
Stephan
Sub Backup_erstellen_3()
Datei = ThisWorkbook.Name
Phad = ThisWorkbook.Path
On Error Resume Next
Kill Phad & "\" & "Formeln_vorhanden" & Format(Now, "YY-MM-DD") & "Backup.xlsm"
ActiveWorkbook.SaveCopyAs Filename:=Phad & "\" & "Dateiname" & Format(Now, "YY.MM.DD_HH-MM- _
SS") & "Backup.xlsm"
End Sub

Sub NurWerte()
Dim i As Integer, Sh As Integer
Sh = Worksheets.Count
For i = 1 To Sh
With Sheets(i)
.Activate
.Cells.Copy
.Cells.PasteSpecial Paste:=xlPasteValues
.Cells(1, 1).Select
Application.CutCopyMode = False
End With
Next i
Sheets(1).Select
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sicherungskopie
03.08.2019 17:14:10
volti
Hallo Stephan,
hier mal ein Ansatz (nur kurz getestet), wie Du das ggf. lösen könntest. Hier und da ist noch was an Deine Bedürfnisse anzupassen, usw.
Sub Erstelle_Sicherungskopie()
'Sicherungskopie anlegen
 Dim WkB As Workbook, WSh As Worksheet, DateiPfad As String, VBComp As Object
'Datei unter anderem Namen kopieren
 DateiPfad = ThisWorkbook.Path & "\" & "Dateiname" & Format(Now, "YY.MM.DD_HH-MM-SS") & "Backup.xlsm"
 ThisWorkbook.SaveCopyAs Filename:=DateiPfad
 Workbooks.Open Filename:=DateiPfad
 Set WkB = ActiveWorkbook
'Zu löschende Blätter hier kommagetrennt auflisten
 WegBlatt = "ISP,Mehrfach"
 
 With Application
  .ScreenUpdating = False
  .DisplayAlerts = False
  .EnableEvents = False
 End With
 For Each WSh In WkB.Worksheets
  If InStr("," & WegBlatt & ",", "," & WSh.Name & ",") > 0 Then
     WSh.Delete                                  'Blatt löschen
  Else
     WSh.Cells.Copy
     WSh.Cells.PasteSpecial Paste:=xlPasteValues 'Formeln entfernen
  End If
 Next WSh
 
 
'Jetzt die Module weg
 For Each VBComp In WkB.VBProject.VBComponents
     If VBComp.Type = 1 Then
       With VBComp.CodeModule
         .DeleteLines StartLine:=1, Count:=.CountOfLines      'code entfernen
       End With
     End If
 Next VBComp
 
 WkB.Save
 WkB.Close
 With Application
  .ScreenUpdating = True
  .DisplayAlerts = True
  .EnableEvents = True
 End With
 MsgBox "Bin fertig!", vbOKOnly Or vbInformation, "Sicherungskopie anlegen"
End Sub

viele Grüße
Karl-Heinz

Anzeige
AW: Sicherungskopie
04.08.2019 12:26:44
Stephan
Hallo Heinz,
vielen Dank. Ich habe noch eine Anpassung vornehmen müssen, da meine Originaldatei eine xlb Datei ist. Deswegen musste ich DateiPfad = ThisWorkbook.Path & "\" & "Dateiname" & Format(Now, "YY.MM.DD_HH-MM-SS") & "Backup.xlsm" in ...Backup.xlb ändern. Falls jemand anders ein ähnliches Problem hat. Dann funktioniert der Makro wunderbar. Vielen Dank undeinen schönen Sonntag.
Grüße
Stephan
AW: Sicherungskopie
04.08.2019 19:24:32
volti
Hallo Stephan,
vielen Dank für die Rückmeldung. Ich selbst arbeite fast nur mit xlsb, weil die kleiner sind und hatte es auch damit getestet und natürlich einen Fehler erhalten. Hatte mich auch gewundert, warum Du "Dateiname" als Festwert verwenden willst.
Für ein flexibles Backup würde ich den Dateinamen und Dateiformat beibehalten und nur zusätzlichen Text einfügen.
Z.B. so:
Dim Arr() As String
 Arr = Split(ThisWorkbook.FullName, ".")
 DateiPfad = Arr(0) & Format(Now, "_YY.MM.DD_HH-MM-SS_") & "Backup." & Arr(UBound(Arr))

viele Grüße
Karl-Heinz
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige