Hallo an Alle,

Ich benutze folgenden Code um Zeilen zu verknüpfen.

Wo bei in der ersten Spalte eine Nr steht und in der Zweiten Spalte die Nr von der ersten Splate mit der ich die Zeile Verknüpfen will.

Das Problem, das manchmal auftritt  ist unerklärbar und zwar, schreibt er mir weiterhin die Formeln in die Zeilen nach dem die Makro gelaufen ist.

Das Seltsame ist das es nur manchmal auftritt.

Liegt es Vileicht am Code?? Weis nicht wo der Fehler sein kann.

Sub ConectLink()
    Dim a As Range
    Dim LZeile As String
    Dim Bereich As Range
    LZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    On Error Resume Next
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        Set Bereich = ThisWorkbook.Sheets("K").Range("C40:C" & LZeile)
        For Each a In Bereich
            If a <> Empty Then
                If a.Offset(0, -1).Value <> a.Value Then
                    Range(a.Offset(0, 10), a.Offset(0, 17)).FormulaR1C1 = "=VLOOKUP(RC3,R40C2:R" & LZeile & "C20,R39C,0)"
                    Range(a.Offset(0, 10), a.Offset(0, 17)).Interior.ColorIndex = 43
                Else
               
                End If
            Else
           
            End If
        Next
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    Set Bereich = Nothing
End Sub

----------------------------

Sub DisconectLink()
    Dim a As Range
    Dim LZeile As String
    Dim Bereich As Range
    LZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        Set Bereich = ThisWorkbook.Sheets("K").Range("C40:C" & LZeile)
        For Each a In Bereich
            If a <> Empty Then
                If a.Offset(0, -1).Value <> a.Value Then
                    Range(a.Offset(0, 10), a.Offset(0, 17)).ClearContents
                    Range(a.Offset(0, 10), a.Offset(0, 17)).Interior.ColorIndex = 0
                Else
               
                End If
            Else
           
            End If
        Next
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    Set Bereich = Nothing
End Sub

Vielen Dank für die Hilfe

Paulo