Tabellen sichern und wiederherstellen
11.12.2006 19:55:58
Michael
mit meinen beiden bestehenden Marko´s sichere ich Monatstabellen ( Januar - Dezember ), die ich bei Bedarf auch wieder einlesen kann.
Jetzt möchte ich gerne noch weiter Tabellen bzw. Zellenbereiche per Makro sichern und bei Bedarf wiederherstellen können.
Mit einfügen möchte ich:
Tabelle1 ---> c15:n15
Tabelle2 ---> K5:K7, G23:G43, B51:B61, H79
Tabelle3 ---> D8:E30
Tabelle4 ---> C7:G40
Tabelle5 ---> A12:P118
Hier mein bestehenden Makro´s:
Sub Sichern()
Dim wbZ As Workbook, wbQ As Workbook
Dim i As Integer, n As String
Application.ScreenUpdating = False
Set wbQ = ActiveWorkbook
i = 1
n = Format(DateSerial(2000, i, 1), "MMMM")
wbQ.Sheets(n).Copy
Set wbZ = ActiveWorkbook
With wbZ
For i = 2 To 12
n = Format(DateSerial(2000, i, 1), "MMMM")
wbQ.Sheets(n).Copy After:=.Sheets(.Sheets.Count)
Next i
End With
Application.ScreenUpdating = True
If Application.Dialogs(xlDialogSaveAs).Show(ThisWorkbook.Path) = False Then
MsgBox "Sicherung wurde nicht gespeichert!"
Else
ActiveWorkbook.Close
End If
End Sub
Sub Wiederherstellen()
Const Restore = "A18:N400"
Dim i As Integer, n As String
Dim wbQ As Workbook, wbZ As Workbook
Set wbZ = ActiveWorkbook
If Application.Dialogs(xlDialogOpen).Show(ThisWorkbook.Path) = False Then
MsgBox "Abbruch"
Exit Sub
End If
Set wbQ = ActiveWorkbook
For i = 1 To 12
n = Format(DateSerial(2000, i, 1), "MMMM")
wbQ.Sheets(n).Range(Restore).Copy _
wbZ.Sheets(n).Range(Restore)
Next i
wbQ.Close False
End Sub
Könnte mir jemand den Code entsprechend anpassen oder einen Denkanstoss geben ?
Mfg
Michael