@fcs Datei sichern
26.01.2007 13:56:52
Odje.K
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