Sunburstdiagramm entsprechend Zellen aus anderer Mappe färben

[SiriKlaus]

Hallo liebes Clever Team,

ich möchte gerne die Zellfarben aus der Apfel-Birne-Urtabelle, der übersichthalber, auf die Zellfarben im Sunburst übertragen. Die Logik dahinter ist wie folgt: An einem Baum lassen sich Früchte finden. Die jeweilige Zelle dazu ist mit einer Prozentzahl hinterlegt, die das Baum/ Frucht Verhältnis angibt. Diese Zelle ist rot, grün oder gelb eingefärbt (bereits automatisch). Und genau diese Farbe hätte ich gerne automatisch in einem Sunburstdiagramm wiedergegeben.
Anmerk: Das Sunburstdiagramm ist in verschiedene Ringe aufgebaut (Ring 0 ist die Mitte, Ring i ist der äußerste), die Ringabschnitte werden, am Beispiel einer Uhr, von 12 Uhr an im Uhrzeigersinn Zelle für Zelle aufgebaut (Bei einem Sunburst mit einem Ring und vier Unterteilung wird also zuerst der Ringabschnitt rechts oben, dann rechts unten, links unten und links oben aufgebaut).
Das Diagramm liest sich von innen nach außen: Baum 1 und Baum 2 haben jeweils verschiedene Eigenschaften. Eine Unregelmäßigkeit ist, dass ein Baum nicht zwingend Äpfel, Birnen und Pfirsiche trägt, sondern auch nur Birnen oder Äpfel und Pfirsiche.. etc. (d. h. Ringabschnitte sind nicht einheitlich)
Anbei habe ich die beiden Dateien und hier meinen "angerissenen Code" für das Einfärben des zweiten Rings nach den Zellfarben aus der Urtabelle:

Code:

Option Explicit

Dim thisworkbook As Workbook
Dim i As Integer
Dim c As Integer
Dim z As Integer
Dim farbe As Integer
Dim Urtabelle As worksheet
Dim wkbdaten as workbook
Dim rng As Range

Sub sun()

On Error GoTo FEHLER
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

    Workbooks.Open "L:\Pfad\Name.xlsm"
Set wkbDaten = Workbooks("Urtabelle.xlsm")
Set Urtabelle = wkbDaten.Sheets("Urtabelle-SHEET")

FEHLER:
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With


'Wie viele Ringabschnitte haben wir?

c = 0
For z = 1 To 50
If Cells(z, 1) <> empty Then
c = c + 1
End If
Next z

'Bäume einfärben
For i = 6 To c 
farbe = Urtabelle.Cells(i, 1).Interior.Color
    If Urtabelle.Cells(i, 1).Value <> Empty Then
    ThisWorkbook.Sheets("sheet2").FullSeriesCollection(2).Points(i).Select
        With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColorindex = farbe
        .Transparency = 0
        .Solid
        End With
    End If
End Sub

Beim Zugriff auf die Urtabelle erscheint die Fehlermeldung Overflow. Woran könnte das liegen? Ich hoffe der Ansatz kann Euch verdeutlichen worauf ich hinaus möchte.


Ich danke vielmals für jede Mithilfe!