Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
840to844
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
840to844
840to844
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

@fcs Datei sichern

@fcs Datei sichern
26.01.2007 13:56:52
Odje.K
Hallo Franz,
Kann man das Makro auch so umbauen, dass nur der Druckbereich des aktiven Blattes in eine neue Datei geschrieben wird ?
Wenn die Möglichkeit gegeben ist, kann ich dann nochmal deine Hilfe in Anspruch nehmen !
Gruß Odje.K

Sub sicherung_VarianteAlt()
'Für ältere Excelversionen
Dim wbThis As Workbook, wbSicherung As Workbook, I As Integer
Dim wksThis As Worksheet, wksSicherung As Worksheet, Bereich As Range, Zelle As Range
Set wbThis = ThisWorkbook
'Neue Mappe mit einer Tabelle anlegen
Set wbSicherung = Application.Workbooks.Add(xlWBATWorksheet)
Set wksThis = wbThis.Worksheets(1) 'Hier ggf. die 1 ändern oder den Namen in Anführungszeichen
Set wksSicherung = wbSicherung.Worksheets(1)
wksSicherung.Activate
'Tabellennamen in Sicherung übernehemn
wksSicherung.Name = wksThis.Name
If wksThis.PageSetup.PrintArea = "" Then 'kein Druckbereich festgelegt
Set Bereich = wksThis.UsedRange
Else
Set Bereich = wksThis.Range(wksThis.PageSetup.PrintArea)
End If
'Spaltenbreiten in Sicherung einstellen
For Each Zelle In wksThis.Range(Bereich.Cells(1, 1), Bereich.Cells(1, Bereich.Columns.Count))
wksSicherung.Columns(Zelle.Column - Bereich.Column + 1).ColumnWidth = Zelle.EntireColumn.ColumnWidth
Next
'Formate und Werte kopieren
Bereich.Copy
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
wksSicherung.Cells(1, 1).Select
wbSicherung.SaveAs "D:\" & Left(wbThis.Name, Len(wbThis.Name) - 4) & _
Format(Now, "_DD.MM.YY_hhmmss") & ".xls"
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: @fcs Datei sichern
26.01.2007 14:51:24
fcs
Hallo Odje,
änder folgende Zeile

Set wksThis = wbThis.Worksheets(1) 'Hier ggf. die 1 ändern oder den Namen in Anführungszeichen
in
Set wksThis = ActiveSheet

Gruß
Franz
AW: @fcs Datei sichern
26.01.2007 15:34:13
Odje.K
Hallo Franz,
Für die schnelle Antwort besten Dank.
Irgendwo ist da noch ne' Macke drin, denn in die Sicherungsdatei ist leer, d.h. ohne Daten.
Gruß Odje.K
AW: @fcs Datei sichern
26.01.2007 17:20:15
fcs
Hallo Odje,
ich hatte leider die Reihenfolge des gerade aktiven Blattes beim Ablauf des Makros übersehen, so hat das Makro eine Sicherheitskopie des gerade angelegten leeren Blattes erstellt.
In folgender Reihenfolge der Zeilen sollte es klappen.
Gruß
Franz

Sub sicherung_VarianteAlt()
'Für ältere Excelversionen
Dim wbThis As Workbook, wbSicherung As Workbook, I As Integer
Dim wksThis As Worksheet, wksSicherung As Worksheet, Bereich As Range, Zelle As Range
Set wbThis = ThisWorkbook
Set wksThis = ActiveSheet
Set wbSicherung = Application.Workbooks.Add(xlWBATWorksheet)
Set wksSicherung = wbSicherung.Worksheets(1)
wksSicherung.Activate
'Tabellennamen in Sicherung übernehemn
wksSicherung.Name = wksThis.Name
If wksThis.PageSetup.PrintArea = "" Then 'kein Druckbereich festgelegt
Set Bereich = wksThis.UsedRange
Else
Set Bereich = wksThis.Range(wksThis.PageSetup.PrintArea)
End If
'Spaltenbreiten in Sicherung einstellen
For Each Zelle In wksThis.Range(Bereich.Cells(1, 1), Bereich.Cells(1, Bereich.Columns.Count))
wksSicherung.Columns(Zelle.Column - Bereich.Column + 1).ColumnWidth = Zelle.EntireColumn.ColumnWidth
Next
'Formate und Werte kopieren
Bereich.Copy
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
wksSicherung.Cells(1, 1).Select
wbSicherung.SaveAs "D:\" & Left(wbThis.Name, Len(wbThis.Name) - 4) & _
Format(Now, "_DD.MM.YY_hhmmss") & ".xls"
End Sub

Anzeige
AW: @fcs Datei sichern
26.01.2007 18:15:02
Odje.K
Hallo Franz,
alles Bestens, Danke
Gruß Odje

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige