Hallo Zusammen,
folgendes Script:
Code:
Application.ScreenUpdating = True
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
ws.Range("A1", ActiveCell.SpecialCells(xlLastCell)).Copy
ws.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next ws
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Range("B2").Value & " " & Format(Date, "DD-MM-YYYY") & ".xls"
Es soll mir meine Mappe unter neuem Namen, nur mit den Werten speichern.
Das funktioniert soweit auch schon.
Jetzt ist die Frage, wie kann ich dem Script sagen, dass es nur bestimmte Sheets speichern soll. Ich brauche nicht alle. Ein Ansatz war:
Code:
Sheets(Array("1", "2", "3")).Select
..
Kann jemand helfen?
Viele Grüße,
Jules
Hallo, :19:
probiere es mal so:
Code:
Option Explicit
Sub Main()
Dim wksSheet As Worksheet
Dim strTMP As String
On Error GoTo Fin
strTMP = ThisWorkbook.Worksheets("Tabelle6").Range("B2").Value
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Sheets(Array("T1", "T2", "T3", "T4", "T5")).Copy
With ActiveWorkbook
For Each wksSheet In .Worksheets
wksSheet.UsedRange.Value = wksSheet.UsedRange.Value
Next wksSheet
.SaveAs ThisWorkbook.Path & "\" & strTMP & " " & Format(Date, "DD-MM-YYYY") & ".xls", 56
.Close False
End With
Fin:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
If Err.Number <> 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
musst Du noch "
Tabelle6" - die Tabelle mit dem
Dateinamen in
B2 und natürlich "
Sheets(Array..." die
Namen der
Tabellenblätter.
Hi,
danke für die Hilfe.
Allerdings bekomme ich: error 9 index außerhalb des gültigen bereichs
Woran könnte das liegen?
VG
Hallo, :19:
Du musst die Anpassungen vornehmen! Deine Tabellenblätter werden sicher nicht "T1, T2..." heißen. Und Tabelle6 muss auch angepasst werden.
Das habe ich schon getan
Code:
Option Explicit
Sub Main()
Dim wksSheet As Worksheet
Dim strTMP As String
On Error GoTo Fin
strTMP = ThisWorkbook.Worksheets("Tabelle1").Range("B2").Value
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Sheets(Array("P&L", "Auswertung", "Protokoll")).Copy
With ActiveWorkbook
For Each wksSheet In .Worksheets
wksSheet.UsedRange.Value = wksSheet.UsedRange.Value
Next wksSheet
.SaveAs ThisWorkbook.Path & "\" & strTMP & " " & Format(Date, "DD-MM-YYYY") & ".xls", 56
.Close False
End With
Fin:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
If Err.Number <> 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Hallo, :19:
habe es mal mit Deinen Tabellenblattnamen probiert - geht. :21:
"Index außerhalb des gültigen Bereichs" bedeutet in der Regel, dass man etwas falsch geschrieben hat!
Sorry. Mein Fehler
Oben muss es natürlich nicht heißen "Tabelle1", sondern hier gehört auch der Blattname rein...
Danke Dir!
Allerdings kopiert mir dein Script nicht die Werte in die neue Mappe.
Mein Script hat alle Werte kopiert und die Formeln rausgelassen. Bei deinem Script erhalte ich zwar eine Kopie meiner Blätter, mit einem etwas anderen Layout, aber ohne Werte in den Zellen.^
Wähle ich hier "select": Sheets(Array("T1", "T2", "T3", "T4", "T5")).Copy anstatt "copy" funktioniert es zwar. Ich erhalte aber wieder alle Blätter und nicht die aus dem Array..
Hallo, :19:
ich kann es nur an meiner Testdatei probieren - und da klappt es. :21:
Lade doch mal eine Beispieldatei hoch, dann sehen wir weiter.
Hallöchen,
lasse doch den Code schrittweise durchlaufen und schaue, was bei jedem Schritt passiert.
Speziell nach dem Schritt
Sheets(Array("P&L", "Auswertung", "Protokoll")).Copy
solltest Du eine neue Datei mit den 3 Blättern und den darin enthaltenen Formeln nebst Ergebnissen haben. Wie schaut es da aus?