Excel - VBA Script _ Speichern eines bestimmten Bereiches

[cumulonimbus8]

Warum die 3 Reihen löschen falls ihr Dasein gewünscht ist?
Warum Massen wuchten wenn ein Range unter Erhalt der ZA reicht?
CN8

 

[Janush]

Weil hier Aufwand und Nutzen in keiner Relation mehr stehen. Die ersten 3 Zeilen sind nicht gewünscht, da ja erst ab der 4. Kopiert werden soll. Und bezüglich der Massen.....ich bezweifle stark das hier mehr als 100 Zeilen bewegt werden. 1Mio leere Reihen lasse ich nicht gelten, das dauert 2 Sekunden, wenn überhaupt.

Das Hauptproblem momentan ist ja nicht die Range, sondern das Format welches nicht kopiert wird. Man kann natürlich auch Farbe und Spaltenbreite einzeln duplizieren, aber wie gesagt....Aufwand vs. Nutzen ;-)

 

[ds_cheater]

Hi,
also ich habe noch ein wenig Code zusammengeschustert (Programmieren kann man das in meinem Fall nicht nennen ). Jetzt wird eigentlich alles so kopiert wie ich möchte, nur die Zeile 4 (der Quelldatei), welche in der Quelldatei 30 Pixel hoch ist, ist in der Zieldatei nur noch 18,75 Pixel hoch.

Wenn ihr mir sagt, was da noch verkehrt ist, dann ist alles supi .

Sub Speichern()

Dim Neue_Datei_Name As String
Dim Diese_Datei_Name As String
Dim Dieses_Blatt As Integer

'Gleich aussteigen wenn hier schon etwas nicht stimmt
Neue_Datei_Name = Application.GetSaveAsFilename(InitialFileName:="", fileFilter:="Excel-Arbeitsmappe (*.xlsx), *.xlsx")
If Neue_Datei_Name_Suffix = "Falsch" Then Exit Sub

'Diese beiden braucht man für die Range-Aktion weiter unten
Diese_Datei_Name = ActiveWorkbook.Name
Dieses_Blatt = ActiveSheet.Index

'Neue Arbeitsmappe (um einzufügen und so separiert zu speichern)
Workbooks.Add
ActiveWorkbook.SaveAs Neue_Datei_Name
'Eine Zweitverwertung - Abtrennen der Pfadangabe
Neue_Datei_Name = ActiveWorkbook.Name

'Range.Copy to other workbooks
Workbooks(Diese_Datei_Name).Worksheets(Dieses_Blatt).Range("A4:H100").Copy
Workbooks(Neue_Datei_Name).Worksheets("Tabelle1").Range("A1:H100").PasteSpecial Paste:=xlPasteAll

'Range.Copy to other workbooks
Workbooks(Diese_Datei_Name).Worksheets(Dieses_Blatt).Range("A4:H100").Copy
Workbooks(Neue_Datei_Name).Worksheets("Tabelle1").Range("A1:H100").PasteSpecial Paste:=xlPasteAllUsingSourceTheme

'Range.Copy to other workbooks
Workbooks(Diese_Datei_Name).Worksheets(Dieses_Blatt).Range("A4:H100").Copy
Workbooks(Neue_Datei_Name).Worksheets("Tabelle1").Range("A1:H100").PasteSpecial Paste:=xlPasteColumnWidths

End Sub

Grüße

 

[Janush]

Jawoll, mit dem Holzhammer

Versuchs doch auch noch mit xlPasteRowHights, wenn es das gibt. Habe ehrlich nicht nachgeschaut.

Sehr gut gemacht. Du könntest noch alles zu einem Block zusammen fassen. Sowas wie:

...Range.Copy

With...Range()
.PasteSpecial...
.PasteSpecial...
.PasteSpecial...
End with

Muss aber nicht, geht auch so und der nächste Code wird dann wieder etwas schöner

 

[ds_cheater]

Hey, dafür das ich Gärtner bin und kein "Coder", ist der Code super .

Melde mich, wenn ich weiter geforscht habe.....