Archivierung mit Sheets.Add
09.01.2015 12:30:29
Tim
folgende Prozedur funktioniert nicht und ich verstehe nicht wo der Fehler liegt.
Prinzipiell möchte ich aus einer Mappe ein ganzes Sheet archivieren mit einem Checkup ob das jeweilige Datum jeweils schon archiviert wurde (Überschreiben, ja/nein).
Sowohl das PasteSpecial als auch Sheets.Add verursachen Fehler. Verstehe aber nicht wieso.
Vielen Dank für jede Hilfe und viele Grüsse
Sub Archivieren3()
Dim archivdate As String
Dim answer As Integer
Dim i As Long
archivdate = [B2].Text
Cells.Select
Selection.Copy
Workbooks.Open Filename:="***.xlsx"
For i = 1 To Worksheets.Count
If Sheets(i).Name = archivdate Then
answer = MsgBox("Dieses Datum wurde bereits archiviert, überschreiben?", vbYesNo + _
vbQuestion, "Archivierung")
If answer = vbYes Then
Sheets(archivdate).Delete
Sheets.Add
ActiveSheet.Name = archivdate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Save
Else
Exit Sub
End If
End If
Next
Sheets.Add
ActiveSheet.Name = archivdate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Save
End Sub