Clever-Excel-Forum

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: [attachment=47325]

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

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

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

Hi,

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

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 Smile

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

Niko

HKindler

Niko

HKindler

Niko