Sheets speichern ohne Formeln - Nur Werte

[jules]

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

[00202]

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

Anpassen musst Du noch " Tabelle6" - die Tabelle mit dem Dateinamen in B2 und natürlich "Sheets(Array..." die Namen der Tabellenblätter.

[jules]

Hi,

danke für die Hilfe.
Allerdings bekomme ich: error 9 index außerhalb des gültigen bereichs

Woran könnte das liegen?

VG

[00202]

Hallo, :19:

Du musst die Anpassungen vornehmen! Deine Tabellenblätter werden sicher nicht "T1, T2..." heißen. Und Tabelle6 muss auch angepasst werden.

[jules]

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

[00202]

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!

[jules]

Sorry. Mein Fehler

Oben muss es natürlich nicht heißen "Tabelle1", sondern hier gehört auch der Blattname rein...


Danke Dir!

[jules]

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..

[00202]

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.

[schauan]

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?