Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Sheets speichern ohne Formeln - Nur Werte
#1
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
Antworten Top
#2
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.
________
Servus
Case
Antworten Top
#3
Hi,

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

Woran könnte das liegen?

VG
Antworten Top
#4
Hallo, :19:

Du musst die Anpassungen vornehmen! Deine Tabellenblätter werden sicher nicht "T1, T2..." heißen. Und Tabelle6 muss auch angepasst werden.
________
Servus
Case
Antworten Top
#5
Das habe ich schon getan Smile

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
Antworten Top
#6
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!
________
Servus
Case
Antworten Top
#7
Sorry. Mein Fehler Smile

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


Danke Dir!
Antworten Top
#8
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..
Antworten Top
#9
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.
________
Servus
Case
Antworten Top
#10
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?
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste