Office: Werte-Blatt und Diagramm-Blatt in neue Mappe kopieren

Hallo, allerseits!

Ich versuche gerade, aus einer bestehenden Auswertung einige Blätter in eine neue Mappe zu kopieren, um diese dann auf einem "Ergebnis"-Laufwerk ohne Makros abzuspeichern.

Folgende Routine (bislang):

Code:

Public Sub Exportiere_Ergebnis()

    Dim w1 As Workbook
    Dim s1 As Worksheet
    Dim w2 As Workbook
    Dim s2 As Worksheet
    Dim s As Long

    InitialisiereVariablen

    Set w1 = ThisWorkbook

    For s = 1 To 5

        Select Case s
            Case 1
                Set s1 = w1.Worksheets(sh_werte)
            Case 2
                Set s1 = w1.Worksheets(sh_diagramme)
            Case 3
                Set s1 = w1.Worksheets(mrpz)
            Case 4
                Set s1 = w1.Worksheets(abgz)
            Case 5
                Set s1 = w1.Worksheets(zugz)
        End Select

        If (s = 1) Then
            s1.Copy
            Set w2 = ActiveWorkbook
            Set s2 = w2.Worksheets(w2.Worksheets.Count)
          Else
            s1.Copy after:=s2
            Set s2 = w2.Worksheets(w2.Worksheets.Count)
        End If

    Next s

End Sub

(sh_werte enthält die Datenquellen für die Diagramme auf sh_diagramme, die anderen 3 blätter sind weitere Detail-Werte-Blätter, aus denen die Zusammenfassungen in sh_werte resultieren.)

Dies liefert mir die benötigten Blätter in einer neuen Mappe, soweit so gut, aber... Insbesondere die Datenquelle der Diagramme verweist nach wie vor auf die Mappe, in der das Blatt ursprünglich war. Das hilft mir also nicht so ganz weiter.

Welche Möglichkeit habe ich, die Blätter so zu kopieren, daß die Formeln und sonstigen Bezüge quasi "lokal" in der neuen Mappe bleiben und nicht auf eine externe Mappe zeigen?

Gruß, Michael

 

Hi Michael,

du musst doch nur den Datenbereich der Diagramme an die Tabellenblätter in der neuen Arbeitsmappe anpassen und in den Formeln ersetzt du den Namen der Ursprungsmappe per Suchen/Ersetzen.

Bis später,
Karin

 

Das ich das muß, ist mir schon klar. Ich denke, das schrieb ich auch, vielleicht nur mit anderen Worten.

Die Frage war: Wie?

Ansatz war ja: Ich gehe nach dem Kopieren der Blätter alle Zellen und alle Diagramme auf allen Blättern durch und suche nach '...'! um das zu entfernen. Aber das scheint mir viel zu aufwändig und langsam.

Da gibt es doch sicher eine simplere Methode, oder?

Gruß, Michael

 

Hi Michael,

Suchen/Ersetzen in Formeln lässt sich durchaus mit dem Makrorekorder aufzeichnen.

Hier der Code für die Diagramme:

Code:

Sub TabellennameErsetzen()
    Dim inZaehler As Integer
    Dim chDiagramm As ChartObject
    For Each chDiagramm In ActiveSheet.ChartObjects
        For inZaehler = 1 To chDiagramm.Chart.SeriesCollection.Count
            chDiagramm.Chart.SeriesCollection(inZaehler).Formula = Application.Substitute( _
                chDiagramm.Chart.SeriesCollection(inZaehler).Formula, _
                ThisWorkbook.Name, ActiveWorkbook.Name)
        Next inZaehler
    Next chDiagramm
End Sub

Bis später,
Karin

 

Prima, der scheint soweit auch zu funktionieren. Ich habe ihn minimal für meine Bedürfnisse angepaßt. Weiß auch nicht mehr, was ich denn vermurkst hatte, als ich es so versucht hatte. So geht's auf alle Fälle und scheint, bei den paar Diagrammen, auch nicht allzu lange zu rechnen.

Hmmm... Haste da mal'n konkrteren Tip?

Über "Bearbeiten - Ersetzen... Strg-H" kann ich nicht in Formeln ändern.

Und "Bearbeiten - Verknüpfungen..." krieg ich, weder manuell noch per Makro, befriedigend zum Laufen.

Der Code-Teil, um den sich der oben von mir gepostete erweitert:

Code:

[...]
    Next s

    w2.SaveAs "t:\dummy.xls"

    wkb1 = w1.Name
    wkb2 = w2.Name

Debug.Print wkb1 & " --> " & wkb2

    ActiveWorkbook.ChangeLink Name:=wkb1, NewName:=wkb2, Type:=xlExcelLinks

    For s = 1 To w2.Worksheets.Count
        Set s2 = w2.Worksheets(s)
Debug.Print "* " & s2.Name

        For Each cob In s2.ChartObjects
            For d = 1 To cob.Chart.SeriesCollection.Count
Debug.Print "  - " & cob.Chart.SeriesCollection(d).Formula
                cob.Chart.SeriesCollection(d).Formula = Application.Substitute( _
                  cob.Chart.SeriesCollection(d).Formula, _
                  wkb1, wkb2)
Debug.Print "    --> " & cob.Chart.SeriesCollection(d).Formula
            Next d
        Next cob

    Next s

1. Problem: Das "saveas" - Hier werden erstmal ein paar "Nicht genügend Speicher" Fehlermeldungen ausgeworfen. Das kenne ich schon, wenn ein SVERWEIS im Spiel ist, der auf eine externe Mappe verweist. Nicht nur höchst unschön, sondern völlig unbrauchbar, weil dieses Makro später unbeaufsichtigt laufen soll.

2. Problem: das "changelink" - Ohne vorheriges "saveas" würde hier versucht werden, sowas wie "Mappe5" statt des vorherigen Dateinamens einzusetzen. Das geht leider nicht, weil es eben keine Datei mit dem Namen gibt. Würde hier heißen: Es muß vorher ein "saveas" erfolgen. Leider scheint das "changelink" kein "" zu akzeptieren, um den externen Link nur zu entfernen.

Und wie jetzt weiter?

Ich würde nur höchst, höchst ungern mit einer Schleife alle Zellen auf allen Blättern durchlaufen, um .Formula auszulesen und alles zwischen [ und ] zu löschen. Das würde sicher gehen, aber dann ist das Ding stundenlang am Rechnen, schätze ich mal. Die 3 entscheidenden Blätter haben typischerweise zwischen 30.000 und 45.000 Zeilen mit 80+ Spalten. Nur die Zusammenfassung für die Diagramme ist kürzer, arbeitet dafür aber kräftig mit SVerweis und, was noch schlimmer ist, Matrix-Formeln.

Gruß, Michael

 

Hi Michael

Also bei mir zeichnet der Makrorecorder beim Ändern in Formeln dies auf:

Code:

    Cells.Replace What:="[Mappe3]", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Bis später,
Karin