Hardcopy Makro mit Loop

Forumthread: Hardcopy Makro mit Loop

Alexandra

Hallo an alle,
bei einer sehr großen und sich ständig ändernden Datei würde ich gern ein Makro einfügen, das einfach und unkompliziert eine neue Datei erstellt, in der alle eingeblendeten Blätter mit den gleichen Namen als Hardcopy vorhanden sind. Die neue Datei sollte in "HC " umbenannt und im Ordner "Archiv", der sich im selben Ordner wie die kopierte Datei befindet, gespeichert werden.
Da in der Originaldatei oft neue Blätter hinzukommen könnten, würde ich es gerne so machen:
Makrocodestruktur:
1. Neue Datei erstellen
2. Neue Datei speichern im selben Verzeichnis/Unterordner "Archiv" mit dem Namen "HC " . Dabei ist der Name der Originaldatei und Datum und Uhrzeit beziehen sich natürlich auf den Zeitpunkts der Erstellung der Hardcopy.
3. Für jedes Blatt in der Originaldatei loop durchlaufen:
a. In der Kopie ein neues Blatt einfügen
b. Dieses Blatt so benennen wie das Originalblatt
c. Die Werte aus dem Originalblatt im neuen Blatt einfügen
d. Die Formate aus dem Originalblatt im neuen Blatt einfügen.
4. Die drei Blätter, die automatisch in jeder neuen Arbeitsmappe vorhanden sind, und hier leer sind, löschen.
5. Die Datei speichern und schliessen.
Vielleicht hat auch schon jemand etwas ähnliches gebaut und kann zumindest ein paar Code-Stücke geben. Das wäre eine große Hilfe.
Vielen Dank im Voraus!
Viele Grüsse,
Alexandra

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Hardcopy Makro mit Loop

21.07.2009 18:10:48

Uduuh

Hallo,
die Datei wird als Kopie gespeichert und geschlossen. Das Original musst du dann wieder öffnen.

Sub Kopie()
Dim wks As Worksheet
With ThisWorkbook
For Each wks In .Worksheets
wks.Cells.Copy
wks.Cells.PasteSpecial xlValues
Next
.SaveAs .Path & "\Archiv\HC " & .Name & Format(Now, "YYMMDDhhmmss") & ".xls"
.Close False
End With
End Sub

Gruß ausm Pott
Udo

AW: Hardcopy Makro mit Loop

22.07.2009 10:55:23

Alexandra

Hallo Udo,
vielen Dank für den Code. Aber kann man das auch irgendwie so machen, daß die Originaldatei offen bleibt während nur die Kopie gespeichert und geschlossen wird. Wir arbeiten nämlich nur in der Originaldatei, und die ist sehr umfangreich und enthält viele Verknüpfungen. Es dauert dann einfach zu lange, alles nochmal zu öffnen. Die Hardcopy ist dazu gedacht, die verschiedenen Arbeitsschritte zu dokumentieren.
Werden mit diesem Code auch die Arbeitsblätter entsprechend umbenannt?
Gruss,
Alexandra

AW: Hardcopy Makro mit Loop

22.07.2009 18:31:39

Uduuh

Hallo,
dann so:

Sub Kopie()
Dim wks As Worksheet, wkb As Workbook
Application.ScreenUpdating = False
Set wkb = Workbooks.Add(1)
With ThisWorkbook
For Each wks In .Worksheets
wks.Copy after:=wkb.Sheets(wkb.Sheets.Count)
Next
End With
With wkb
Application.DisplayAlerts = False
.Sheets(1).Delete
Application.DisplayAlerts = True
For Each wks In .Worksheets
wks.Cells.Copy
wks.Cells.PasteSpecial xlPasteAll
Next
.SaveAs ThisWorkbook.Path & "\Archiv\HC " & .Name & Format(Now, "YYMMDDhhmmss") & ".xls"
.Close False
End With
Application.ScreenUpdating = True
End Sub

Gruß ausm Pott
Udo

Beliebteste Forumthreads (12 Monate)

Forumthread: Hardcopy Makro mit Loop

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

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread