Druckbereich in neue Tabelle kopieren

[Harald Friis]

Hallo,

ich hätte da mal wieder eine Frage an die Experten:

Derzeit vorhanden:
- Tabellenblatt mit vielen Formeln und Bezügen aus anderen Blättern
- Diverse Formatierungen, Grafiken eingefügt
- Druckbereich ist definiert


Wunsch:
- diesen Druckbereich per VBA als neue Tabelle speichern bzw. einfach
offen lassen, das reicht auch. Nicht die Bezüge, sondern die Werte wären
nötig.

Falls die neue Tabelle auch einen Namen bekommen kann, bezieht sich der
auf eine Kombination aus einem Wort "Zertifikat" und einem Feldinhalt
aus A5 oder sowas, das ist dann der Name.

Was mir (leider nur) gelungen ist:
- ganzes Tabellenblatt incl. Formatierungen und Grafiken kopieren
- oder Druckbereich ohne Formatierungen, ohne Grafiken kopieren. Die
Bezüge klappen dann auch nicht (#NV).

Hat jemand eine Idee? Vielen Dank im Voraus.

Gruß

Harald Friis

[Claus Busch]

Hallo Harald,

Am Fri, 29 Sep 2017 18:16:08 +0200 schrieb Harald Friis:

> Derzeit vorhanden:
> - Tabellenblatt mit vielen Formeln und Bezügen aus anderen Blättern
> - Diverse Formatierungen, Grafiken eingefügt
> - Druckbereich ist definiert
>
> Wunsch:
> - diesen Druckbereich per VBA als neue Tabelle speichern bzw. einfach
> offen lassen, das reicht auch. Nicht die Bezüge, sondern die Werte wären
> nötig.

wenn du das komplette Blatt kopierst, nimmst du die Format und die
Grafiken mit. Dann musst du nur noch die Formeln in Werte wandeln.
Probiere mal:

Sub CopyValues()
Dim myStr As String

'Hier Tabellennamen anpassen
Sheets("Tabelle1").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = "Zertifikat" & .Range("A5")
myStr = .PageSetup.PrintArea
With .Range(myStr)
.Value = .Value
End With
End With
End Sub


Mit freundlichen Grüßen
Claus
--
Windows10
Office 2016

[Harald Friis]

Hallo Claus,

du brauchst für die Antwort weniger Zeit als ich für die Frage ;-)

Vielen Dank, aber eine Rückfrage:

Verstehe ich das richtig? Ich kopiere zuerst das gesamte Blatt in eine
neue Tabelle und erstelle dann in der neuen Tabelle mit deinem Makro ein
zweites Tabellenblatt mit dem Druckbereich?

Gruß

Harald Friis

[Claus Busch]

Hallo Harald,

Am Fri, 29 Sep 2017 19:01:28 +0200 schrieb Harald Friis:

> Verstehe ich das richtig? Ich kopiere zuerst das gesamte Blatt in eine
> neue Tabelle und erstelle dann in der neuen Tabelle mit deinem Makro ein
> zweites Tabellenblatt mit dem Druckbereich?

nein, du kopierst das komplette Blatt ans Ende der Mappe, gibst ihm
einen neuen Namen und wandelst die Formeln in Werte.

[Harald Friis]

Hallo Claus,

Am 29.09.2017 um 19:07 schrieb Claus Busch:
> Hallo Harald,
>
> Am Fri, 29 Sep 2017 19:01:28 +0200 schrieb Harald Friis:
>
>> Verstehe ich das richtig? Ich kopiere zuerst das gesamte Blatt in eine
>> neue Tabelle und erstelle dann in der neuen Tabelle mit deinem Makro ein
>> zweites Tabellenblatt mit dem Druckbereich?
>
> nein, du kopierst das komplette Blatt ans Ende der Mappe, gibst ihm
> einen neuen Namen und wandelst die Formeln in Werte.

ah, deshalb den Tabellennamen anpassen. Das funzt leider nicht. Es gibt
die Ursprungstabelle, die aber täglich einen neuen Namen bekommt -
[Maßnahme]_[Datum].

Daraus wollte ich ein Blatt in eine neue Tabelle kopieren oder
exportieren, wenn man so will. Das klappt z.B. mit

Sub copy_test()
ActiveWorkbook.Worksheets("Zertifikat").Copy
End Sub

Dann habe ich eine neue Tabelle ("Mappe1") mit einem Blatt
("Zertifikat") mit allen Grafiken und Formatierungen. Allerdings auch
mit den Formeln und nicht den Inhalten. Außerdem auch mit den Daten
außerhalb des Druckbereichs.

Deshalb wollte ich den Inhalt (inkl. Grafiken und Formatierungen) des
Druckbereichs in eine neue Tabelle kopieren. Diese neue Tabelle kann
"Mappe1" heißen oder, noch etwas schicker, "Zertifikat_[Name]".
Letzteres wäre aber Kür, weil sie in vielen Fällen wohl nicht
gespeichert, sondern nur gedruckt werden wird.

Vielleicht geht das auch gar nicht so ohne weiteres? Auf jeden Fall
danke für deine Mühe.

Gruß

Harald Friis

[Claus Busch]

Hallo Harald,

Am Sat, 30 Sep 2017 13:32:30 +0200 schrieb Harald Friis:

> Sub copy_test()
> ActiveWorkbook.Worksheets("Zertifikat").Copy
> End Sub
>
> Dann habe ich eine neue Tabelle ("Mappe1") mit einem Blatt
> ("Zertifikat") mit allen Grafiken und Formatierungen. Allerdings auch
> mit den Formeln und nicht den Inhalten. Außerdem auch mit den Daten
> außerhalb des Druckbereichs.
>
> Deshalb wollte ich den Inhalt (inkl. Grafiken und Formatierungen) des
> Druckbereichs in eine neue Tabelle kopieren. Diese neue Tabelle kann
> "Mappe1" heißen oder, noch etwas schicker, "Zertifikat_[Name]".
> Letzteres wäre aber Kür, weil sie in vielen Fällen wohl nicht
> gespeichert, sondern nur gedruckt werden wird.

probiere es mal so:

Sub NeueMappe()
Dim myStr As String
Dim varRng As Variant
Dim cNum As Integer

Sheets("Zertifikat").Copy

With ActiveWorkbook
With Sheets(1)
myStr = .PageSetup.PrintArea
varRng = Split(Split(myStr, ":")(1), "$")
cNum = Asc(varRng(1)) - 63
'Löscht alle Spalte nach dem Druckbereich bis Spalte 30
.Range(.Cells(1, cNum), .Cells(500, cNum + 30)).Clear
'Löscht alle Zeilen nach Druckbereich bis Zeile 500
.Rows(varRng(2) & ":500").Clear
.UsedRange.Value = .UsedRange.Value
End With
.SaveAs ThisWorkbook.Path & "/Zerifikat_" _
& Sheets(1).Range("A5") & ".xlsx"
.Close
End With
End Sub

[Claus Busch]

Hallo Harald,

Am Sat, 30 Sep 2017 14:04:12 +0200 schrieb Claus Busch:


> 'Löscht alle Zeilen nach Druckbereich bis Zeile 500
> .Rows(varRng(2) & ":500").Clear

Fehler! Ändere obige Zeile zu:

.Rows(varRng(2) + 1 & ":500").Clear

[Harald Friis]

Hallo,

Am 30.09.2017 um 14:06 schrieb Claus Busch:
> Hallo Harald,
>
> Am Sat, 30 Sep 2017 14:04:12 +0200 schrieb Claus Busch:
>
>
>> 'Löscht alle Zeilen nach Druckbereich bis Zeile 500
>> .Rows(varRng(2) & ":500").Clear
>
> Fehler! Ändere obige Zeile zu:
>
> .Rows(varRng(2) + 1 & ":500").Clear

es ist für mich eine vollkommen neue Erfahrung: ich pflege ein paar
Excel-Sheets, die von ca. 25 Menschen parallel benutzt werden. Meine
bisherige Art - falls es irgendwie klappt, bin ich zufrieden - stößt da
wirklich an ihre Grenzen. Ständig funktioniert auf einem Rechner
irgendetwas anders als geplant ...

Danke für deine Formel, die ich aber nicht zum Laufen bekommen habe.
Gelöst habe ich das jetzt wie folgt:

Sub Zertifikate_Export()
'
' Export von Zertifikate Makro
'
ActiveSheet.Select
ActiveSheet.Copy
ActiveSheet.Shapes.Range(Array("Drop Down 1")).Select
Selection.Delete
Range("A11:J14").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A23:J43").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("Q:U").Select
Selection.Delete
Range("A6:C6").Select

End Sub

Ich kopiere das gesamte Blatt, dann bleiben die Formatierungen erhalten.
Die Datenbereiche werden nur als Werte hereingeschrieben. Zudem werden
die nicht benötigten Bereiche gelöscht, es bleibt dann nur der
Druckbereich über. Scheint bislang zu funktionieren.

Danke dir für alle deine umfangreichen Hilfen, ich habe auch schon
wieder einen neuen Thread aufgemacht.

Gruß

Harald Friis