Beispiel.xlsm Tabelle kopieren und ohne Makros als (.xlsx) als neue Datei auf meinem Desktop speichern.

Question

Hallo guten Tag, ich möchte Teile (z.B. A1 bis AW45) von einer Beispiel.xlsm Tabelle kopieren und ohne Makros als (.xlsx) als neue Datei auf meinem Desktop speichern. Der neue Dateiname befindet sich in der Beispiel.xlsm Datei in Zelle (“AW2“). Es sollen beim Kopieren nur das Format (Spaltenbreite, Zeilenhöhe, Schriftart und Zellenfarbe) übernommen werden jedoch keine Formeln und dergleichen. Die Formular und ActiveX-Steuerelemente sollten in der neuen (.xlsx) Tabelle ebenfalls nicht mehr vorhanden sein. Bitte um einen vollständigen vba code. Danke

Answer 1

Hallo Jelena,

du hast nicht geschrieben, ob du den Bereich in der neuen Datei an eine bestimmte Stelle kopieren willst. Falls sich der Bereich nicht verändern soll, kannst du das in etwa so machen:

Sub Speichern()

'Markierten Bereich und Dateiname ermitteln
Dim rng As Range, Dateiname As String, Desktop As String, shp As Shape
Set rng = Range("A1:AW45")
Dateiname = Range("AW2")

'Blatt kopieren um Änderungen am Original zu vermeiden.
ActiveSheet.Copy

'Markierten Bereich in Fixwerte umwandeln und rundrum alles löschen
ActiveSheet.Cells.ClearContents
rng.Copy
ActiveSheet.Range("A1:AW45").PasteSpecial xlValues
Application.CutCopyMode = False

'alle Buttons und Zeichnungseleemente löschen.
For Each shp In ActiveSheet.Shapes
  shp.Delete
Next shp

'Desktoppfad ermitteln und Datei speichern
Desktop = Environ("Userprofile") & "\Desktop\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Desktop & Dateiname, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
End Sub

Gruß Mr. K.

Answer 2

Hallo Mr. K. beim testen bleibt das Makro 

Sub Speichern()

'Markierten Bereich und Dateiname ermitteln
Dim rng As Range
Set rng = Selection
Dateiname =        hängen. Der Bereich der neuen Datei fängt in "A1" an. Danke

Answer 3

An welcher Stelle bleibts denn hängen? Bei mir funktioniert alles wie gewünscht.

Wie gesagt musst du den zu kopierenden Bereich zuvor markieren, bevor du das Makro startest. Falls es sich immer um denselben Bereich handelt, kannst du natürlich das Wort Selection auch durch Range("A1:AW45") ersetzen. Dann wird aber immer nur dieser Bereich kopiert.

Der Dateiname in Zelle AW2 sollte natürlich möglichst kurz sein. Ein Wort oder zwei reichen aus, den Rest macht das Makro.

Nachtrag: Verwendest du vielleicht ganz oben die Zeile Option explicit? Dann musst du natürlich die fehlenden Variablen noch nachdeklarieren. Das bekommst du aber sicher allein hin, sonst würdest du diese Zeile nicht benutzen. (Dateiname und Desktop als String und shp als Shape)

Gruß Mr. K.

Answer 4

Hallo Mr. K. beim testen bleibt das Makro 

Sub Speichern()

'Markierten Bereich und Dateiname ermitteln
Dim rng As Range
Set rng = Range ("A1:AW45")     'Selection geändert
Dateiname = hängen.

Der Bereich von ("A1:AW45") bleibt immer der gleiche. Danke

Answer 5

Och Jelenchen , 

du hast immer noch nicht verraten an welcher Stelle es hängt und ob eine Fehlermeldung kommt. Bei mir läuft alles durch. Hab jetzt im Code oben die fehlenden Variablen ergänzt. Hättest du nach meiner Beschreibung auch machen können. Damit hängts schon mal nicht bei Dateiname. Das Einzige Andere was ich mir vorstellen, kann ist ein hängenbleiben beim letzten Befehl SaveAs. Das passiert aber nur, wenn die Zelle AW2 leer ist. Da du dort aber den Dateinamen drin stehen hast, kann es eigentlich nicht passieren, dass es hängenbleibt. Die Angabe eines Dateinamens ist nunmal Pflicht und lässt sich nicht umgehen.

Gruß Mr. K.

Answer 6

Hallo Mr. K. ich habe es jetzt mit dem neuem code versucht und es kommt folgendes raus (nur Formatierung jedoch ohne Daten und der code in der .xlsx Datei wird nicht gelöscht). https://supportnet.de/forum/?qa=blob&qa_blobid=16878358499649995064 Die Daten aus der .xlsm Tabelle stammen teilweise aus einer Formel. Danke

Answer 7

Hallo Jelena,

Jetzt ist mir alles klar. Kann es sein, dass du den Code in ein Tabellenmodul kopiert hast? Das habe ich nicht geschrieben. Ausführbare Makros gehören immer in ein Standardmodul (z.B. Modul1). Wenn Codeteile in ein anders Modul kommen, schreibe ich das dazu. Diese werden dann aber zumeist nicht manuell gestartet.

Der Code wird erst gelöscht, wenn du bei der Rückfrage auf Ja klickst. Diese Meldung kommt bei mir komischerweise nicht, ist mir aber aus früheren Excel-Versionen wohl bekannt. Die kannst du mit Application DisplayAlerts = False unterdrücken.

Hab den Code oben jetzt nochmals minimal angepasst. Sollte nun funktionieren. Wenn nicht, melde dich nochmal.

Gruß Mr. K.

Answer 8

Hallo Mr. K. bitte um Entschuldigung kann zurzeit nicht Testen melde mich später. Trotzdem vielen Dank bis dahin.

Answer 9

Hallo Mr. K. guten Tag bin wieder da und möchte fragen ist es möglich den folgenden code so zu schreiben sodass nicht eine .pdf Datei entsteht, sondern eine .xls oder noch besser eine .xlsx Datei. Danke

Sub Pdf_Ausgabe_Reservierung() 'pdf ausgabe
    
Dim Spalte As Integer
Dim SpalteEnd As Integer
With Tabelle5           'Tabelle angeben z:B.Tabelle5
SpalteEnd = .UsedRange.Columns.Count

For Spalte = 7 To 40
If .Cells(42, Spalte).Value <= 0.1 Then 'kontrolliert wird in Zeile 42
.Columns(Spalte).Hidden = True
Else
.Columns(Spalte).Hidden = False
End If
Next Spalte

End With
    Dim strFileName As String, strPath As String, strFolder As String, varFile, blnOpen As Boolean
    strFolder = MsgBox("Soll die neue PDF-Datei im gleichen Ordner wie die Excel-Mappe gespeichert werden?", vbYesNoCancel, "PDF speichern")
    If strFolder = vbNo Then
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = ActiveWorkbook.Path
            .Title = "Verzeichnisauswahl"
            If .Show = -1 Then strPath = .SelectedItems(1)
        End With
    ElseIf strFolder = vbYes Then
        strPath = ActiveWorkbook.Path
    ElseIf strFolder = vbCancel Then
        Exit Sub
    End If
    strFileName = strPath & "\" & ActiveSheet.Range("AQ8").Value & ".pdf"
    Do Until Dir(strFileName, vbNormal) = ""
        varFile = Application.InputBox("Eine Datei mit diesem Namen existiert bereits. Bitte einen neuen Namen eingeben.", , "\" & ActiveSheet.Range("AQ8").Value & ".pdf")
        If varFile = False Then Exit Sub
        strFileName = strPath & "\" & varFile
    Loop
    blnOpen = IIf(MsgBox("Soll die Neue PDF-Datei nach dem Speichern geöffnet werden?", vbYesNo, "PDF öffnen") = vbYes, True, False)
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=blnOpen
    
    Range("o3").Select

End Sub

Answer 10

Hallo Jelena,

wie es scheint ist das eine neue Frage. Bitte eröffne dafür einen neuen Thread. Dann helfen die Kollegen und/oder ich dir gern weiter.

Gruß Mr. K.