Abgespeckte Sicherheitskopie via Makro erzeugen...

Hallo!
Ich möchte gerne via Makro eine Sicherheitskopie meiner Excel-Mappe anlegen.
Dabei sollen nur die ersten 4 Tabellenblätter berücksichtigt werden, der Rest kann aus Platzgründen gelöscht werden. Ebenfalls kann (in der Sicherheitskopie) das Makro welches die Sicherheitskopie veranlasste gelöscht werden, andere sollen erhalten bleiben.
Die Sicherheitskopie soll den Namen der Mappe inkl dem Wort Sicherheitskopie tragen und im selben Pfad abgelegt werden in der sich die Originalmappe befindet, allerdings in einem eigens dafür angelegten Ordner("Sicherheitskopien").
Eine MessageBox soll nun den Anwender zeigen wo diese Kopie gesichert wurde.
Die Originalmappe soll dabei nicht geschlossen werden.
Über eine Lösung würde ich mich freuen.
Vielen Dank!
Gruß
Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Sicherheitskopie() Dim wks1 As Worksheet Dim strPfad As String Application.ScreenUpdating = False Application.DisplayAlerts = False strPfad = ThisWorkbook.Path & "\Sicherheitskopie\" & _ Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "Sicherheitskopie.xls" ThisWorkbook.SaveCopyAs strPfad Workbooks.Open strPfad ' *** WICHTIG *** Hier die vier Namen der Blätter anpassen die nicht gelöscht werden sollen ! For Each wks1 In ActiveWorkbook.Worksheets If wks1.Name <> "Tabelle1" And wks1.Name <> "Tabelle2" And wks1.Name <> "Tabelle3" And _ wks1.Name <> "Tabelle4" Then wks1.Delete Next wks1 ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Modul1") ActiveWorkbook.Save ActiveWorkbook.Close Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Die Sicherheitskopie wurde in " & vbCr & vbCr & strPfad & " abgelegt !", _ vbInformation, " Sicherheitskopie" End Sub

Sub Sicherheitskopie() Dim wks1 As Worksheet Dim strPfad As String Application.ScreenUpdating = False Application.DisplayAlerts = False strPfad = ThisWorkbook.Path & "\Sicherheitskopie\" & _ Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "Sicherheitskopie.xls" ThisWorkbook.SaveCopyAs strPfad Workbooks.Open strPfad ' *** WICHTIG *** Hier die vier Namen der Blätter anpassen die nicht gelöscht werden sollen ! For Each wks1 In ActiveWorkbook.Worksheets If wks1.Name <> "DRG02" And wks1.Name <> "DRG03" And wks1.Name <> "ACTUAL_DRG02" And _ wks1.Name <> "ACTUAL_DRG03" Then wks1.Delete Next wks1 ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Modul1") ActiveWorkbook.Save ActiveWorkbook.Close Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Die Sicherheitskopie wurde in " & vbCr & vbCr & strPfad & " abgelegt !", _ vbInformation, " Sicherheitskopie" End Sub

Sub Sicherheitskopie() Dim wks1 As Worksheet Dim strPfad As String Application.ScreenUpdating = False Application.DisplayAlerts = False strPfad = ThisWorkbook.Path & "\Sicherheitskopie\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "Sicherheitskopie.xls" ThisWorkbook.SaveCopyAs strPfad Workbooks.Open strPfad ' *** WICHTIG *** Hier die vier Namen der Blätter anpassen die nicht gelöscht werden sollen ! For Each wks1 In ActiveWorkbook.Worksheets If wks1.Name <> "DRG02" And wks1.Name <> "DRG03" And wks1.Name <> "ACTUAL_DRG02" And wks1.Name <> "ACTUAL_DRG03" Then wks1.Delete Next wks1 ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents ("Modul1") ActiveWorkbook.Save ActiveWorkbook.Close Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Die Sicherheitskopie wurde in " & vbCr & vbCr & strPfad & " abgelegt !", vbInformation, " Sicherheitskopie" End Sub

Hallo Thomas,
versuche mal diese Version, damit wird alles was VBA ist gelöscht:


Sub Sicherheitskopie()
Dim wks1 As Worksheet
Dim strPfad As String
Dim vbc As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
strPfad = ThisWorkbook.Path & "\Sicherheitskopien\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "Sicherheitskopie.xls"
ThisWorkbook.SaveCopyAs strPfad
Workbooks.Open strPfad
' *** WICHTIG ***  Hier die vier Namen der Blätter anpassen die nicht gelöscht werden sollen !
For Each wks1 In ActiveWorkbook.Worksheets
If wks1.Name <> "Tabelle1" And wks1.Name <> "Tabelle2" And wks1.Name <> "Tabelle3" And wks1.Name <> "Tabelle4" Then wks1.Delete
Next wks1
With ActiveWorkbook.VBProject
For Each vbc In .VBComponents
Select Case vbc.Type
Case 1, 2, 3
.VBComponents.Remove .VBComponents(vbc.Name)
Case 100
With .VBComponents(vbc.Name).CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
MsgBox "Unbekannter VBA Type !", vbCritical
End Select
Next vbc
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Die Sicherheitskopie wurde in " & vbCr & vbCr & strPfad & " abgelegt !", _
vbInformation, " Sicherheitskopie"
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !

Beliebteste Forumthreads (12 Monate)

Abgespeckte Sicherheitskopie via Makro erzeugen...

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Abgespeckte Sicherheitskopie via Makro erzeugen...

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread