[VBA] Kopieren bestimmter Blätter

[jules]

Hallo zusammen,

folgendes Szenario:

Ich habe eine Arbeitsmappe mit mehreren Blättern. Nun möchte ich gerne über einen Button einen Teil dieser Blätter, also nur eine bestimmte Auswahl als Excel-Datei ohne Formeln kopieren.
Folgenden Ansatz habe ich:

Code:

Option Explicit
Sub ExcelExport()
Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
Application.Calculation = xlCalculationManual 'automat.Berechnung ausschalten

'Exportiert Auswertung ohne Formlen als xlsx
Dim wksSheet As Worksheet
   Dim strTMP As String
   On Error GoTo Fin
   strTMP = ThisWorkbook.Worksheets("Auswertung").Range("B2").Value
   With Application
       .ScreenUpdating = False
       .DisplayAlerts = False
       .EnableEvents = False
   End With
    Worksheets(Array("Auswertung", "Protokoll", "Protokoll INTERN")).Select
    With ActiveWorkbook
       For Each wksSheet In .Worksheets
           wksSheet.UsedRange.Value = wksSheet.UsedRange.Value
       Next wksSheet
       .SaveAs ThisWorkbook.Path & "\" & strTMP & " " & Format(Date, "DD-MM-YYYY") & ".xlsx", 51
       Worksheets("Auswertung").Activate
       .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
Application.Calculation = xlCalculationAutomatic 'automat.Berechnung einschalten
Application.ScreenUpdating = True 'Bildschirmaktualisierung einschalten

End Sub

Problem ist, dass er mir die komplette Arbeitsmappe abspeichert und nicht wie gewünscht nur die ausgewählten Blätter.
Zudem wäre es schön, wenn er sie im Hintergrund speichert und nicht jedesmal die komplette Mappe schließt.

Danke für eure Ideen

Jules

[Kuwer]

Hallo Jules,

ändere die Zeile

Worksheets(Array("Auswertung", "Protokoll", "Protokoll INTERN")).Select

in

Worksheets(Array("Auswertung", "Protokoll", "Protokoll INTERN")).Copy

Gruß Uwe

[jules]

Hi Uwe,

danke für deine Antwort.

.Copy habe ich auch schon versucht. Macht zwar was ich will, ändert jedoch - warum auch immer!?! - meine kompletten Farben in der Tabelle.. übernimmt sie leider nicht 1:1
(Siehe Bild anbei. Oben das Original, unten der "Export") Zudem schließt er mit meinem Script (.select) die Original Mappe komplett, nach erfolgreichem Export. Bei .Copy bleibt das Original weiterhin geöffnet .. was mir egentlich lieber wäre. Aber eben nur in 1:1 Kopie

Vielleicht hast du weitere Ideen, wo der Fehler liegt?


Danke und VG


Dateien bitte im Forum hochladen: https://www.clever-excel-forum.de/thread-326.html

[cysu11]

Hallo,


habe ich ausgegraben aus ein alten Projekt :)

Code:

Sub ExportDaten()
  If MsgBox("Sind Sie sicher, dass Sie die ausgewählten Blätter exportieren möchten? ", vbYesNo) = vbYes Then
    Application.ScreenUpdating = False
    With Workbooks.Add(xlWBATWorksheet)
      .Worksheets(.Worksheets.Count).Name = "Auswertung"
      ThisWorkbook.Sheets("Auswertung").Cells.Copy .Worksheets(.Worksheets.Count).Cells(1)
     
      .Worksheets.Add after:=.Worksheets(.Worksheets.Count)
      .Worksheets(.Worksheets.Count).Name = "Protokoll"
      ThisWorkbook.Sheets("Protokoll").Cells.Copy .Worksheets(.Worksheets.Count).Cells(1)
     
      .Worksheets.Add after:=.Worksheets(.Worksheets.Count)
      .Worksheets(.Worksheets.Count).Name = "Protokoll INTERN"
      ThisWorkbook.Sheets("Protokoll INTERN").Cells.Copy .Worksheets(.Worksheets.Count).Cells(1)
        .SaveAs ThisWorkbook.Path & "\" & "upload.xlsx"
    End With
    Application.ScreenUpdating = True
  End If
End Sub

LG
Alexandra

[jules]

Hi Alexandra,

erst einmal, Danke!

Aber auch hier das gleiche Problem. Er zerschießt mir beim "Export" das komplette Layout.
Woran kann das denn liegen... sehr eigenartig...

Grüße

[cysu11]

Hi Jules,


dann benötigen wir deine Datei mit den entsprechenden Formatierungen, die Daten kannst du ja Beispieldaten eingeben.


LG
Alexandra

[schauan]

Hallöchen,

Dein erster Ansatz mit dem Ersetzen der Formeln ist ja schon mal gut.

Ich würde anschließend die nicht benötigten Blätter löschen und die Datei dann mit SaveCopyAs speichern.

Problem ist allerdings auch hier, dass beim Speichern als Kopie Excel automatisch bei dieser Datei bleibt, die nun nicht mehr das Original ist.

Du müsstest also zuerst das Original nochmal öffnen und dann schließt Du die Kopie