Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
824to828
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
824to828
824to828
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Tabellen Sichern und Wiederherstellen

Tabellen Sichern und Wiederherstellen
09.12.2006 13:53:24
Michael
Hallo Excel Profi´s,
mit meinen bestehenden Marko´s werden meine 12 Monatstabellen ( Janaur - Dezember ) gesichert und bei bedarf wieder eingelesen. Wie kann ich noch weiter Tabellen sichern lassen bzw. wieder einlesen lassen.
Es würde mich freuen, wenn auch noch z.B. Tabelle1, Tabelle2 gespeichert und wieder eingelesen werden könnte.
Hier mein bisherigen Marko´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

Mfg
Michael

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellen Sichern und Wiederherstellen
09.12.2006 16:23:47
fcs
Hallo Michael,
ungetestet, müßte es etwa so funktionieren

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
wbQ.Sheets("Tabelle1").Copy After:=.Sheets(.Sheets.Count)
wbQ.Sheets("Tabelle2").Copy After:=.Sheets(.Sheets.Count)
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
wbZ.Sheets("Tabelle1").UsedRange.ClearContents
wbQ.Sheets("Tabelle1").UsedRange.Copy _
wbZ.Sheets("Tabelle1").Range(UsedRange.Address)
wbZ.Sheets("Tabelle2").UsedRange.ClearContents
wbQ.Sheets("Tabelle2").UsedRange.Copy _
wbZ.Sheets("Tabelle2").Range(UsedRange.Address)
wbQ.Close False
End Sub
Gruss
Franz

Anzeige
AW: Tabellen Sichern und Wiederherstellen
12.12.2006 21:01:27
Michael
Sorry Franz, is wohl bei meinem ganzen Trubel untergegangen.
Danke für die Hinweis.
Mfg
Michael

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige