AW: Tabellenblatt exportieren ohne Private Sub
13.10.2023 09:41:33
JBR
Hallo Thorsten,
ich benutzte diesen Code um das Tabellenblatt in eine neue Datei zu exportieren.
Das OriginalTabellenblatt hat einige ausgeblendete Spalten die in der neuen Datei nicht verfügbar sein sollen, deshalb habe ich auch "ActiveSheet.Copy Before:=ActiveSheet" erstmal nicht angezweifelt.
'Kopiert Tabelle in neue Arbeitsmappe, nur Werte, ausgeblendete Spalten und Formeln werden gel_scht
Dim wbOriginal As Workbook
Dim wbExport As Workbook
Dim wksExport As Worksheet
Dim Spalte As Integer
Dim shp As Shape
Dim AnhangXLXS As Variant
Application.EnableEvents = False
Application.ScreenUpdating = False
'Dupliziert aktuelles Tabellenblatt in Tabellenblatt Temp
ActiveSheet.Copy Before:=ActiveSheet
ActiveSheet.Name = "Temp"
'Variablen setzen
Set wbOriginal = ThisWorkbook
Set wksExport = wbOriginal.Worksheets("Temp") 'Tabelle die kopiert werden soll
' Datei Speichern falls nicht gespeichert
If wbOriginal.Saved = False Then
wbOriginal.Save
End If
wksExport.Unprotect ' Schreibschutz aufheben
wksExport.UsedRange.Value = wksExport.UsedRange.Value 'Formeln durch Werte ersetzen
wksExport.Copy 'Blatt in neue Arbeitsmappe kopieren
Set wbExport = ActiveWorkbook
Set wksExport = wbExport.Worksheets(1)
With wksExport
Sheets("Temp").Name = "Export" 'Blatt umbenennen
'Ausgeblendete Spalten l_schen
For Spalte = .UsedRange.Column + .UsedRange.Columns.Count To 1 Step -1
If .Columns(Spalte).Hidden = True Then .Columns(Spalte).Delete
Next
'Alle Spalten einblenden
.Cells.EntireColumn.Hidden = False
End With
'Alle Objekte löschen
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
'Schreibschutz
ActiveSheet.Protect "123456", DrawingObjects:=False, Contents:=True, Scenarios:=False
ActiveSheet.EnableSelection = xlNoRestrictions
'Kopf und Fußzeile löschen
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
ActiveWindow.View = xlNormalView
fileSaveName = Application.GetSaveAsFilename(InitialFileName:=fileSaveName, FileFilter:="Microsoft Excel-Arbeitsmappe (*.xlsx), *.xlsx")
ActiveWorkbook.SaveAs Filename:=fileSaveName
wbExport.Close savechanges:=False
Application.DisplayAlerts = True
'zurueck zur Ausgangsdateidatei
wbOriginal.Activate
'Tabellenblatt Temp löschen
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("Temp").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Vielleicht ist es möglich den Code so zu erweitern, dass der Private Sub gelöscht wird.
Viele Grüße,
Jörg