mit einem Marko sicher ich aus bestimmten Tabellen Zellen und mit dem zweiten möchte ich die Sicherung wieder einlesen.
Das Sichern der Tabellenblätter funktioniert wie es soll. Allerdings wird beim Einlesen der Sicherung nur die Monatstabellen ( Januar - Dezember ) eingelesen. Die übrigen Tabellenblätter werden nicht berücksichtigt. Es erschein die Fehlermeldung "Index außerhalb des gültigen Bereichs". Woran liegt das ?
Hier die 2 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
wbQ.Sheets("Produktionszuschluss").Copy After:=.Sheets(.Sheets.Count)
wbQ.Sheets("Geschäftsplan").Copy After:=.Sheets(.Sheets.Count)
wbQ.Sheets("Neugeschäftsbonus").Copy After:=.Sheets(.Sheets.Count)
wbQ.Sheets("Erneuerungswettbewerb").Copy After:=.Sheets(.Sheets.Count)
wbQ.Sheets("Provisionskontrolle").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
wbQ.Sheets("Produktionszuschuss").Range("c15:n15").Copy _
wbZ.Sheets("Produktionszuschuss").Range("c15:n15")
wbQ.Sheets("Geschäftsplan").Range("K7:K5").Copy _
wbZ.Sheets("Geschäftsplan").Range("K7:K5")
wbQ.Sheets("Geschäftsplan").Range("g23:g43").Copy _
wbZ.Sheets("Geschäftsplan").Range("g23:g43")
wbQ.Sheets("Geschäftsplan").Range("b51:b61").Copy _
wbZ.Sheets("Geschäftsplan").Range("b51:b61")
wbQ.Sheets("Geschäftsplan").Range("e51:e61").Copy _
wbZ.Sheets("Geschäftsplan").Range("e51:e61")
wbQ.Sheets("Geschäftsplan").Range("h79").Copy _
wbZ.Sheets("Geschäftsplan").Range("h79")
wbQ.Sheets("Neugeschäftsbonus").Range("d8:e30").Copy _
wbZ.Sheets("Neugeschäftsbonus").Range("d8:e30")
wbQ.Sheets("Erneuerungswettbewerb").Range("c7:g40").Copy _
wbZ.Sheets("Erneuerungswettbewerb").Range("c7:g40")
wbQ.Sheets("Provisionskontrolle").Range("A12:p118").Copy _
wbZ.Sheets("Provisionskontrolle").Range("A12:p118")
wbQ.Close False
End Sub
Mfg
Michael