VBA, xlsm Arbeitsblatt von Arbeitsmappe als xlsx datei in bestimmten ordner speichern

[Niko]

Hallo an alle,

möchte von einer .xlsm Datei nur ein Blatt in eine neue Datei als .xlsx speichern.
Habe im Internet ein VBA Code gefunden der ungefähr das machen sollte, doch es klappt nicht.

Es kommt Fehlermeldung “Für diese Aktion müssen alle verbundenen Zellen dieselbe Größe haben.“

Gleichzeitig wäre es besser wenn der Speicherpfad und Name direkt im Code hinterlegt ist.
Speicherpfad ist eine NAS.
 
Anbei die Datei und der VBA Code.

Datei:
  Speichern_in_NAS.xlsm (Größe: 22,02 KB / Downloads: 0)

Code:

Sub TeilbereichSpeichern()
Dim objWB As Workbook
Dim strRange As String, strFile As String


On Error GoTo ErrExit
GMS

strRange = "A1:F20" 'Bereichsadresse die Kopiert werden soll

strFile = Application.GetSaveAsFilename( _
    fileFilter:="Excel Files (*.xls), *.xls")

If strFile <> "Falsch" Then
    Set objWB = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Sheets("Werte").Range(strRange).Copy
    With objWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        .PasteSpecial xlPasteColumnWidths
    End With
    Application.CutCopyMode = False
    objWB.SaveAs strFile
    objWB.Close
End If

ErrExit:
GMS True
If Err <> 0 Then MsgBox Err.Description
Set objWB = Nothing
End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long

With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Modus Then
        .Calculation = lngCalc
    Else
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End If
    .Cursor = IIf(Modus, -4143, 2)
    .CutCopyMode = False
End With

End Sub

Danke im Voraus,


 Niko

[HKindler]

Hi,

theoretisch reicht ein Einzeiler:

Code:

Sub BlattSpeichern()
ThisWorkbook.Sheets("Werte").SaveAs "\\NAS\gewünschter\Pfad\Dateiname", 51
End Sub()

Wenn die Formeln durch Werte ersetzt werden sollen:
Sub BlattSpeichern()

Code:

Worksheets("Werte").Copy
With ActiveSheet
    .UsedRange.Cells.Value = .UsedRange.Cells.Value
    .SaveAs "\\NAS\gewünschter\Pfad\Dateiname", 51
    .Parent.Close
End With
End Sub

[Niko]

Hallo Helmut,
 
vorab vielen Dank für deine Antwort.
Habe den Code versucht durchzulaufen und es tauchen Fehler auf.
Das erste Fenster das aufgeht, fragt ob ich VBA mit kopieren möchte oder nicht (eigentlich ist es klar, dass ich es nicht möchte, deswegen auch von xlsm in xlsx).
Das zweite Fenster danach kommt “Microsoft Visual Basic for Applications“ Roter Kreis mit weisen X Zeichen und die Zahl 400.
 
Kopiert in der NAS hat es auch nicht, habe es so eingetragen wie beschrieben.

PS. Habe den Fehler 400 gefunden, habe ein "\" nicht hinzugefügt gehabt.

Die Abfrage ob ich die MAkros speichern möchte oder nicht...wie bekomme ich die raus?
 
 
Danke
Niko

[HKindler]

Hi,

Application.DisplayAlerts = False müsste die Nachfrage abschalten. Dann speichern. Danach dann wieder auf True setzen.

[Niko]

Habe es so eingebaut und es läuft durch...hoffe das ich es richtig eingebaut habe...falls nicht bitte um kurze rückmeldung...würde helfen

Code:

Option Explicit

Sub BlattSpeichern()
Worksheets("Werte").Copy
With ActiveSheet
    .UsedRange.Cells.Value = .UsedRange.Cells.Value
    .Application.DisplayAlerts = False
    .SaveAs "\\NAS\gewünschter\Pfad\Dateiname", 51
    .Parent.Close
End With
Application.DisplayAlerts = True
End Sub

Danke nochmals


Niko