Verknüpfung von zwei Zellen auf zwei Tabellenblättern

Hallo zusammen!
Ich beschäftige mich seit einigen Tagen intensiv mit VBA und möchte mir hier an einem Beispielprojekt einige Kenntnisse erarbeiten. Jetzt hänge ich aber fest und komme nicht weiter...

Mein Ziel:
Ich möchte auf einem Tabellenblatt, dass ich als aktives Tabellenblatt hinterlege, eine Verlinkung zu einem Tabellenblatt herstellen, dass sich "Übersicht" nennt. Dieses "Übersichts"-Tabellenblatt soll mein Quellblatt sein. Auf diesem "Übersichts"-Blatt habe ich zuvor einige andere Aktionen ausgeführt und referenziere mich hierbei immer auf eine zu Beginn beliebig angewählte Zelle, die ich als "Quellzelle" definieren möchte.

Der Inhalt dieser Quellzelle soll mit der dem Inhalt der Zelle B1 auf meinem aktiven Tabellenblatt verknüpft werden, so dass bei Änderungen des Inhalts in der Quellzelle auf dem "Übersichts"-Blatt sich auch automatisch der Inhalt in dieser Zelle B1 auf dem anderen Tabellenblatt verändert.

Ich habe hierzu mit viel Recherche etc. versucht einen Code zu schreiben, der wie folgt aussieht (Ausgangspunkt ist das Übersicht-Tabellenblatt):

Sub Verknüpfung()

Dim QuellBlatt As Worksheet
Dim ZielBlatt As Worksheet
Dim QuellZelle As Range

Set QuellZelle = ActiveCell
Set QuellBlatt = ThisWorkbook.Sheets("Übersicht")

Sheets("Tabellenblatt2").Select
Set ZielBlatt = ActiveSheet

ZielBlatt.Range("B1").Formula = "=" & QuellBlatt.Name & "!" & QuellZelle.address(External:=True)

End Sub

Dieser Code funktioniert aber nicht und ich komme nicht auf den Fehler.... Kann mir hier einer weiterhelfen?

Danke schon mal im Voraus!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Verknüpfung() Dim QuellBlatt As Worksheet Dim ZielBlatt As Worksheet Dim QuellZelle As Range Set QuellBlatt = ThisWorkbook.Sheets("Übersicht") Set QuellZelle = QuellBlatt.ActiveCell Set ZielBlatt = ThisWorkbook.Sheets("Tabellenblatt2") ZielBlatt.Range("B1").Formula = "=" & QuellBlatt.Name & "!" & QuellZelle.Address(External:=True) End Sub

Sub Verknüpfung() ' Dim QuellZelle As Range Dim QuellBlatt As Worksheet Dim ZielBlatt As Worksheet ActiveCell.Offset(0, 0).Range("A1:B4").Select Set QuellBlatt = ThisWorkbook.Sheets("Prozessübersicht") Set QuellZelle = QuellBlatt.ActiveCell

Hier ist nochmal mein (fast) vollständes Programm... Ich habe nur einen relativ umfangreichen Teil mit '... herausgelassen, bei dem zahlreiche Formatierungen etc. durchgeführt werden. Diese funktionieren bereits und die bringen keinen Mehrwert bei der Lösung meines Problems.
Ich habe den Hinweis mit QAdr=... von Piet eingearbeitet, das funktioniert - vielen Dank dafür!

Mein Problem ist aber leider immer noch nicht gelöst... es funktioniert alles einwandfrei, bis auf die Erstellung der Verknüpfung, als letztlich die letzten beiden Zeilen in meinem Code vor dem End Sub. Hier bekomme ich weiterhin eine Fehlermeldung und die Verknüpfung kann nicht automatisch erstellt werden.
Kann mir hier nochmal einer weiterhelfen, warum die Verknüpfung von der Quellzelle zur Zelle B1 auf dem neu generierten Sheet nicht funktioniert und dementsprechend der Inhalt der Quellzelle nicht in der Zelle B1 abgebildet wird?


Sub Verknüpfung()

        

    Dim QuellZelle As Range

    Dim QuellBlatt As Worksheet

    Dim ZielBlatt As Worksheet

   

   

    QAdr = ActiveCell.Range("A1:B4").address



    Set QuellBlatt = ThisWorkbook.Sheets("Prozessübersicht")

    Set QuellZelle = QuellBlatt.Range(QAdr)

    

     'nachfolgend: Formatierung eines Bereichs auf der Übersichtsseite (Größe: 2 auf 4 Zellen), die aktive Zelle ist hierbei die Zelle oben links in diesem Bereich   

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = -0.149998474074526

        .PatternTintAndShade = 0

    End With

    ActiveCell.Offset(1, 0).Range("A1").Select

    ActiveCell.Offset(-1, 0).Range("A1:B1").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlDot

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    ActiveCell.Offset(1, 0).Range("A1:B3").Select

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Selection.Merge

    ActiveCell.Range("A1:B3").Select

    ActiveCell.FormulaR1C1 = ""

    ActiveCell.Offset(-1, 0).Range("A1").Select

    ActiveCell.FormulaR1C1 = ""

    ActiveCell.Select

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    With Selection

        .HorizontalAlignment = xlGeneral

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    ActiveCell.Offset(1, 0).Range("A1:B3").Select

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

    

    

   'automatisch neues Sheet generieren und ganz rechts als Tabellenblatt einfügen

    Sheets.Add After:=Sheets(Sheets.Count)

    

    ActiveCell.Offset(0, 1).Range("A1").Select

    'Range("b2").Value = varZelle

    ActiveCell.Offset(1, 0).Range("A1").Select

       

    ' Tabellenlayout einfügen 

    'nachfolgend: Formatierung einer Tabelle

    '....

   ' hier das Ende der hier weggelassenen Formatierungen

    'Range("B8:B10").Font.Bold = True

    'Range("B13:B15").Font.Bold = True





    'Erstellen einer Verknüpfung zwischen ursprünglich aktiver Zelle ("Quellzelle") auf dem Sheet "Prozessübersicht" mit der Zelle B1 auf diesem neu hinzugefügten Sheet

   'in der Zelle B1 soll der Inhalt der Quellzelle wiedergegeben werden und bei Veränderungen am Inhalt der Quellzelle sich dann auch der Inhalt der verknüpften B1 Zelle ändern

    

    Set ZielBlatt = activeSheet

    

    ZielBlatt.Range("B1").Formula = "=" & QuellBlatt.Name & "!" & QuellZelle.address(external:=True)

    

  

End Sub

Vielen Dank an alle hilfsbereiten Köpfe hier in diesem Forum für eure Mühen!

Beliebteste Forumthreads (12 Monate)

Verknüpfung von zwei Zellen auf zwei Tabellenblättern

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread