Guten Morgen @m-o,
ich komme zurück zu meinem ersten Beitrag unter dieser Frage. Die eigentliche Datei aus meinem ersten Beitrag hat 20 Arbeitsblätter. Die fünfzehn Schichtpläne plus vier Reserve-Schichtpläne sind in einer Datei. Zu diesen 19 Arbeitsblättern kommt noch der Anwesenheitsplaner der Abteilungen als Arbeitsblatt dazu. Somit hat die Datei 20 Arbeitsblätter. In den 15 Arbeitsblättern werden die Schichtpläne von ca.200 Mitarbeitern verwaltet. Ich habe aus der Datei eine xlsb-Datei gemacht, damit die Berechnungen schneller sind. Die eigentliche Datei ist zurzeit noch ca. 7000 KB groß. Die Größe ist nicht das Problem. Das Problem sind die Schichtpläne selber. Ich habe gezählt, jedes Arbeitsblatt hat 28.836 Funktionen (Formeln). Bei 19 Arbeitsblättern sind es 547.884 Funktionen. Deshalb braucht die Datei zum Öffnen oder zum Schließen geschlagene 15-28 Sekunden. Außerdem ist die Datei für das Simultan-Arbeiten von 6 Schichtführern, 3 Meistern und 3 Stellvertreter freigegeben.
Das war die Vorgeschichte.
Aus den oben genannten Gründen möchte ich die Daten in den Schichtplänen in einer separaten Datei archivieren.
Ich versuche jetzt die Daten in eine andere Datei auszuschneiden, weil das Ausschneiden eine endgültige Angelegenheit ist, hatte ich meinen Versuch mit dem Kopieren der Werte gestartet. Dabei versuchte ich das Format des Originals beizubehalten, aber irgendwie kopieren der Werte in das original Format nicht machbar.
Anschließend beabsichtige ich pro Arbeitsblatt nur drei Kalenderwochen in jedem Arbeitsblatt zu belassen, und somit die Datei leichter zu bekommen. Jedes Mal soll die entstandene vierte Kalenderwoche jedes Arbeitsblatts exportiert (archiviert) werden.
Ich darf die Daten nicht löschen, ich darf sie aber archivieren.
Deshalb füge ich die Beispieldatei aus meiner Frage diesmal mit drei Arbeitsblättern bei.
Ich wäre sehr dankbar, wenn Du eine Idee für mein Problem hast.
Beste Grüße
https://supportnet.de/forum/?qa=blob&qa_blobid=8226273569214718289
Hier ist der Code mit dem ich es versucht habe.
Code:
Sub CopyFormat()
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
' Die Quellarbeitsmappe und das Arbeitsblatt festlegen
Set wbSource = Workbooks.Open("F:\Abwesenheit\Plan_Neu.xlsm")
Set wsSource = wbSource.Worksheets("Pack 1")
' Die Zielarbeitsmappe und das Arbeitsblatt festlegen
Set wbTarget = Workbooks.Open("C:\Users\Zagor\Desktop\Kopie der Schichtpläne.xlsm")
Set wsTarget = wbTarget.Worksheets("Pack1")
' Kopieren Sie das Format von der Quelle in das Zielarbeitsblatt
wsSource.Range("G40:AC" & wsSource.Cells(wsSource.Rows.Count, "AC").End(xlUp).Row).Copy
' Kopieren die Werte von der Quelle in das Zielarbeitsblatt
Sheets("Pack1").Cells(Rows.Count, 1).End(xlUp)(3).PasteSpecial (xlPasteFormats)
Sheets("Pack1").Cells(Rows.Count, 1).End(xlUp)(3).PasteSpecial (xlPasteValues)
' wsTarget.Range("A" & wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteFormats
' ' Kopieren die Werte von der Quelle in das Zielarbeitsblatt
' wsSource.Range("G40:AC" & wsSource.Cells(wsSource.Rows.Count, "AC").End(xlUp).Row).Copy
' wsTarget.Range("A" & wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteValues
'
' ' Kopieren die Werte und das Format von der Quelle in das Zielarbeitsblatt
' wsSource.Range("G40:AC" & wsSource.Cells(wsSource.Rows.Count, "AC").End(xlUp).Row).Copy
' wsTarget.Range("A" & wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteAll
' Schließen die Arbeitsmappen, ohne die Änderungen zu speichern
' wbSource.Close False
' wbTarget.Close True
End Sub
Code:
Sub CopyValues()
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
' Die Quellarbeitsmappe und das Arbeitsblatt festlegen
Set wbSource = Workbooks.Open("F:\Abwesenheit\Plan_Neu.xlsm")
Set wsSource = wbSource.Worksheets("Pack 1")
' Die Zielarbeitsmappe und das Arbeitsblatt festlegen
Set wbTarget = Workbooks.Open("C:\Users\Zagor\Desktop\Kopie der Schichtpläne.xlsm")
Set wsTarget = wbTarget.Worksheets("Pack1")
' Kopieren die Werte von der Quelle in das Zielarbeitsblatt
wsSource.Range("G40:AC" & wsSource.Cells(wsSource.Rows.Count, "AC").End(xlUp).Row).Copy
wsTarget.Range("A" & wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteValues
' Schließen die Arbeitsmappen, ohne die Änderungen zu speichern
wbSource.Close False
wbTarget.Close True
End Sub