Verknüpfungen in andere Tabelle

[kaptainluis]

Hallo liebe Excel Profis!

Ich habe eine sehr große Liste, aus welcher ich Verknüpfungen in eine andere Liste eintragen möchte.

Ich dachte, ich hätte das Problem gelöst, indem ich die .Copyund die .Paste Link=True - Methode benutze, aber es wird nur eine Verknüpfung erstellt, wenn die Zellen einen Inhalt haben. Bei leeren Zellen wird keine Verknüpfung eingefügt!

Wie kann ich das beheben?

Anbei mein CODE:

 

Code:

Sub termine_in_tagekalender()
'Terminverkn?pfungen in TageKalender eintragen, funktioniert instabil, bei fehlern einfach auf weiter im code gehen
i = 1
j = 6
'schleife durch die Kalendertabelle
Do While j < 1200
    Do While i < 1200
        Debug.Print Sheets("Standort-Tabelle").Cells(i, 7).Value
        If Sheets("Standort Tabelle").Cells(i, 7).Value = Sheets("KW Kalender").Cells(j, 2).Value And Sheets("Standort Tabelle").Cells(i, 7).Value <> "" Then
            Do While i < 1200
                'suche ?bereinstimmung von termin
                If Sheets("Standort[color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/color]").Cells(i, 4).Value = "T" Then
                    'Terminspalte kopieren
                    Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 11).Copy
                    'in kalender einf?gen
                    Sheets("KW Kalender").Cells(j + 1, 3).Select
                    ActiveSheet.Paste Link:=True
                End If
                If Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 4).Value = "Aufstellung" Then
                    'Terminspalte kopieren
                    Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 11).Copy
                    'in kalender einf?gen
                    Sheets("KW Kalender").Cells(j + 2, 3).Select
                    ActiveSheet.Paste Link:=True
                End If
                If Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 4).Value = "Abnahme" Then
                    'Terminspalte kopieren
                    Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 11).Copy
                    'in kalender einf?gen
                    Sheets("KW Kalender").Cells(j + 3, 3).Select
                    ActiveSheet.Paste Link:=True
                End If
                If Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 4).Value = "Abnahme T" Then
                    'Terminspalte kopieren
                    Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 11).Copy
                    'in kalender einf?gen
                    Sheets("KW Kalender").Cells(j + 4, 3).Select
                    ActiveSheet.Paste Link:=True
                End If
                If Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 4).Value = "S" Then
                    'Terminspalte kopieren
                    Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 11).Copy
                    'in kalender einf?gen
                    Sheets("KW Kalender").Cells(j + 5, 3).Select
                    ActiveSheet.Paste Link:=True
                End If
                'STOP BEDINGUNG
                If Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 2).Value = "+" Or Sheets("Standort[color=#333333][color=#333333][size=small][font=Tahoma,Verdana,Arial,Sans-Serif][size=small][size=small][font=Tahoma,Verdana,Arial,Sans-Serif] Tabelle[/font][/size][/size][/font][/size][/color][/color]").Cells(i, 4).Value = "+" Then
                    Exit Do
                End If
                i = i + 1
            Loop
        End If
        i = i + 1
    Loop
    i = 1
    j = j + 6
Loop
End Sub

Vielen Dank für Eure Zeit! Wenn ihr an meinem Programmierstil Verbesserungsvorschläge habt, gerne her damit! 

Freundlichen Gruß 
kaptainluis

[Kuwer]

Hallo,

entferne bei

If Sheets("Standort Tabelle").Cells(i, 7).Value = Sheets("KW Kalender").Cells(j, 2).Value And Sheets("Standort Tabelle").Cells(i, 7).Value <> "" Then

das Rotmarkierte.

Gru Uwe