online 1
gast (50)

/ Forum / Tabellenkalkulation

TabellenkalkulationTabellenkalkulation

Fragevon m-o-m vom 08.01.2019, 17:38 Options

Werte kopieren - VBA Makroerweiterung!!!

Aloha Crackz,

Vorab ich habe fast keine Ahnung von VBA. Das uunten aufgeführte Makro ist durch fantastische Hilfe von Euch entstanden (ist schon länger her).

Jetzt habe ich wieder mal ein Problem:

Ich möchte ein Tabellenblatt kopieren und unter einem definerten Namen und Pfad abspeichern. Das klappt per VBA auch (Folgt unten).

Jetzt aber mein Problem: Es sollen nicht die Verknüpfungen kopierten, sondern nur die Werte. Und als Bonus wäre es super wenn das Datum nicht mit vier Stellen Jahreszahl speichert, sondern nur mit zwei.

Vorab schonmal DANKE, DANKE, DANKE und Entschuldigung falls es mein Problem schon mal gab. Ich hab es nicht gefunden.

Also anbei mein bisheriges Makro

Sub Speich_neue_Dat()

Rem Cells.Copy
ActiveSheet.Copy
Rem Workbooks.Add
Rem Sheets("Meldung").Range("A1").PasteSpecial _
REM Paste:=xlPasteValues, Operation:=xlNone, _
REM SkipBlanks:=False, Transpose:=False
Rem Selection.PasteSpecial Paste:=xlPasteFormats, _
REM Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWindow.DisplayZeros = False
Dim Datum
Datum = Split(Range("f3"), ".")
ActiveWorkbook.SaveAs "Pfad" & Datum(2) & Datum(1) & Datum(0) & "_" & Range("e14") & "_" & "0" & Range("f7") & ".xls"
End Sub


Antwort schreiben

Antwort 1 von coros vom 08.01.2019, 20:08 Options

Hallo @m-o-m,

wenn Du keine Verknüpfungen mitkopieren möchtest, kannst Du das Blatt nicht so in eine neue Datei kopieren, sondern Du musst eine neue Datei erstellen und dann nur die Inhalte kopieren. Mit nachfolgendem Makro sollte es funktionieren, wie Du es Dir vorstellst. Außerdem wird im Speichernamen die Jahreszahl mit nur 2 Stellen dargestellt.

[b]Sub Speich_neue_Dat()

Rem Cells.Copy
Cells.Copy
Workbooks.Add
Range("A1").PasteSpecial Paste:=xlPasteValues
Rem Workbooks.Add
Rem Sheets("Meldung").Range("A1").PasteSpecial _
REM Paste:=xlPasteValues, Operation:=xlNone, _
REM SkipBlanks:=False, Transpose:=False
Rem Selection.PasteSpecial Paste:=xlPasteFormats, _
REM Operation:=xlNone, SkipBlanks:=False, Transpose:=False
´ActiveWindow.DisplayZeros = False
Dim Datum
Datum = Split(Range("f3"), ".")
ActiveWorkbook.SaveAs "Pfad" & Format(Range("f3"), "yy") & Datum(1) & Datum(0) & "_" & Range("e14") & "_" & "0" & Range("f7") & ".xls"
End Sub[/b]


Ich hoffe, Du meintest das so? Wenn nicht, melden.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 2 von Beverly vom 08.01.2019, 21:09 Options

Hi,

du schreibst "Verknüpfungen". Wenn damit echte Verknüpfungen zu anderen Tabellen oder Arbeitsmappen und nicht allgemeine Formeln in der Tabelle gemeint sind - hiermit werden nur Verknüpfungen gelöscht, Formeln bleiben jedoch erhalten. In Oliver´s Code wird generell alles durch Werte ersetzt.

Sub tabelle_speichern_ohne_verknuepfung()
    Dim arrLinks As Variant
    Dim inI As Integer
    Dim Datum
    Datum = Split(Range("F3"), ".")
    ActiveSheet.Copy
    arrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
    If Not IsEmpty(arrLinks) Then
        For inI = LBound(arrLinks) To UBound(arrLinks)
            ActiveWorkbook.BreakLink _
                Name:=arrLinks(inI), _
                    Type:=xlLinkTypeExcelLinks
        Next inI
    End If
    ActiveWorkbook.SaveAs "Pfad" & Format(Range("f3"), "yy") & Datum(1) & Datum(0) & "_" & Range("e14") & "_" & "0" & Range("f7") & ".xls"
End Sub


Code unter Verwendung des Teils von Oliver´s Code für das Speichern mit gekürztem Datum.

Bis später,
Karin

Antwort 3 von coros vom 10.01.2019, 06:58 Options

Hallo m-o-m,

da aufgrund technischer Schwierigkeiten hier einige Postings wieder zurückgesetzt wurden, ist leider meine Antwort von gestern Nachmittag auch verschütt gegangen. Daher schreibe ich heute nochmal.

Das die Formate erhalten bleiben sollen hast Du in keiner Deiner Fragen erwähnt. Du solltest zukünftig besser beschreiben, was Du Dir vorstellst, dann kommt man auch schneller zu einem Ergebnis. Nachfolgendes Makro kopiert das aktive Blatt und ersetzt alle Verknüpfungen behält aber die Formatierungen der Zellen bei.

[b]Option Explicit

Sub Speich_neue_Dat()
Dim Pfad As String
Dim Datum
Datum = Split(Range("f3"), ".")
Pfad = "C:\Eigene Dateien\"
ActiveSheet.Copy
Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Rem Workbooks.Add
Rem Sheets("Meldung").Range("A1").PasteSpecial _
REM Paste:=xlPasteValues, Operation:=xlNone, _
REM SkipBlanks:=False, Transpose:=False
Rem Selection.PasteSpecial Paste:=xlPasteFormats, _
REM Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWindow.DisplayZeros = False
ActiveWorkbook.SaveAs Pfad & Format(Range("f3"), "yy") & Datum(1) & Datum(0) & "_" & Range("e14") & "_" & "0" & Range("f7") & ".xls"
End Sub[/b]

Bei Fragen melde Dich bitte.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 4 von m-o-m vom 10.01.2019, 07:29 Options

Hallo Oliver,

um auch meine verschwundene Antwort nachzuholen:

Es funktioniert!!!!!

Danke, Danke, Danke

Gruß m-o-m

Ähnliche Themen

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Version: supportware 1.9.150 / 10.06.2022, Startzeit:Mon Jan 26 01:23:17 2026