Datei clonen aber nur die Werte?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub tttt() Dim wb As Workbook Dim ws As Worksheet ActiveWorkbook.SaveAs Filename:="C:\Users\w050658\Downloads\testkw2.xlsm", _ FileFormat:=xlOpenXMLWorkbookMacroEnabled Set wb = Workbooks("testkw2.xlsm") For Each ws In wb.Worksheets ws.UsedRange.Formula = ws.UsedRange.Value Next ws wb.Close True Set wb = Nothing End Sub

Sub tttt() Dim wbOld As Workbook Dim wbNew As Workbook Dim ws As Worksheet Set wbOld = ActiveWorkbook Workbooks.Add Set wbNew = ActiveWorkbook For Each ws In wbOld.Worksheets wbNew.Sheets.Add ActiveSheet.Name = ws.Name ws.Cells.Copy wbNew.ActiveSheet.Range("A1").PasteSpecial wbNew.ActiveSheet.UsedRange.Formula = wbNew.ActiveSheet.UsedRange.Value Next ws Set wbNew = Nothing Set wbOld = Nothing End Sub

hi
so werden die neuen Blätter immer am Anfang eingefügt.
damit die Reihenfolge beigehalten bleibt, müssen sie am Ende eingefügt werden:

wbNew.sheets.Add After:=wbNew.Sheets(wbNew.Sheets.Count)

die Registerfarbe musst du genauso explizit per Code übernehmen wie den Registernamen.
wie man die Farbe ändert, kannst du dir mit dem MakroRecoder leicht selbst erarbeiten und dann in den Code einbauen.
ggf musst du auch noch die leeren Blätter, die eine neue Mappe automatisch hat, löschen.
diese sollten jetzt am Anfang stehen.
wieviele das sind, kannst du dir ermitteln, nachdem du das neue Workbook erstellt und der Variablen zugewiesen hast (den Code dafür habe ich dir schon gezeigt)
Gruß Daniel

Hi,
klar kannst du alles mit übernehmen - muss halt mit abgefragt werden. Wenn noch Buttons und so weiter dazu kommen ist es wahrscheinlich einfacher, das Workbook einfach unter einem Temporärem Namen abzuspeichern. FÜr das Erfragte - Blattnamen und Reiterfarben - tuns aber auch zwei manuelle Abfragen.
Ich hab dir das Makro mal durchkommentiert.

Sub WorkbookFormellos()
'Variablen definieren
Dim wbOld As Workbook
Dim wbNew As Workbook
Dim ws    As Worksheet
'altes Workbook merken
Set wbOld = ActiveWorkbook
'neues Workbook erstellen, bekommt automatisch Fokus
Workbooks.Add
'Da das neu erstellte Workbook im Fokus ist, kann es mit "ActiveWorkbook" zugewiesen werden
Set wbNew = ActiveWorkbook
'Schleife über alle Worksheets des alten Workbooks
For Each ws In wbOld.Worksheets
'neues Blatt erstellen - ganz vorne
wbNew.Sheets.Add After:=wbNew.Sheets(wbNew.Sheets.Count)
'Name des Blattes übertragen
ActiveSheet.Name = ws.Name
'Farbe des Reiters übertragen
ActiveSheet.Tab.Color = ws.Tab.Color
'Inhalte kopieren
ws.Cells.Copy
'Formate und Werte-statt-Formeln einfügen
wbNew.ActiveSheet.Range("A1").PasteSpecial xlPasteFormats
wbNew.ActiveSheet.Range("A1").PasteSpecial xlPasteValues
Next ws
'Das erste Blatt ist immer noch "Tabelle1". Dies ohne Rückfrage (=DisplayAlert) löschen
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
'Variablen zurücksetzen ist nicht unbedingt nötig, gehört aber zum guten Stil
Set wbNew = Nothing
Set wbOld = Nothing
End Sub

Übrigens: Dass die Registerfarbe mit "sheet.tab.color" angegeben wird, wusste ich nicht. Aber der Makrorekorder wusste es für mich :-)
LG,
Klaus

Dim sh As Worksheet For Each sh In ThisWorkbook.Worksheets sh.Select 0 Next ActiveWindow.SelectedSheets.Copy For Each sh In ActiveWorkbook.Worksheets With sh.UsedRange .Formula = .Value End With Next

Beliebteste Forumthreads (12 Monate)

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread