Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1400to1404
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
Inhaltsverzeichnis

Archivierung mit Sheets.Add

Archivierung mit Sheets.Add
09.01.2015 12:30:29
Tim
Hallo,
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Archivierung mit Sheets.Add
09.01.2015 13:26:46
Tim
Das Sheets. Add Problem konnte ich lösen: Es fehlt ein Exit Sub nach dem 1. End If, sonst stürzt es ab weil es 2x den gleichen Blattnamen vergeben will.
Dennoch bleibt die Problematik mit Selection.PasteSpecial:
Es kommt die Fehlermeldung:
Laufzeitfehler 1004: Die PasteSpecial Methode des Range Objekts konnte nicht ausgeführt werden.
Was passt hier nicht?

AW: Archivierung mit Sheets.Add
09.01.2015 14:19:10
fcs
Hallo Tim,
das Löschen des Tabellenblatt setzt auch den Kopiervorgang zurück, d.h. die zuvor in die Zwischenablage kopierten Daten stehen nicht mehr zum Einfügen zur Verfügung.
Mit nachfolgenden Anpassungen funktioniert es. Dabei wird der zu kopierende Zellbereich einer Variablen zugewiesen und erst nach dem eventuellen Löschen eines Blattes kopiert.
Gruß
Franz
Sub Archivieren3()
Dim archivdate As String
Dim answer As Integer
Dim i As Long
Dim rngData As Range
archivdate = [B2].Text
Set rngCopy = ActiveSheet.Cells
Workbooks.Open Filename:="D:\Test\Archiv\Archiv.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
Application.DisplayAlerts = False
Sheets(archivdate).Delete
Application.DisplayAlerts = True
Exit For
Else
GoTo Beenden
End If
End If
Next
Sheets.Add
ActiveSheet.Name = archivdate
rngCopy.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
Set rngCopy=nothing
Beenden:
End Sub

Anzeige
AW: Archivierung mit Sheets.Add
09.01.2015 14:59:12
Tim
Hallo Franz!
Vielen Dank, funktioniert einwandfrei!
In deinem Source Code ist lediglich noch ein kleiner Leichtsinnsfehler:
Du verwendest rngCopy und rngData als Objekt.
Sonst funktioniert es super.
Schönes We und Danke

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige