Hallo Zusammen,

Ich möchte gerne mein Makro erweitern. Zur Zeit kopiert es mir nach einer Eingabe in Telle D7 im Tabellenblatt "Eingabe" und Überprüfung des Wertes in der Tabelle "BerechneteTeile" nach diesem Wert und kopiert diesen in die Tabelle "Ergebnisse". Das klappt soweit nun möchte ich aber dass gleichzeitig gebprüft wird ob bestimmte Zeilen schon mehrfach kopiert wurden. Beispielsweise soll nach Eingabe eines bestimmten Wertes bei mehr als 2 Speicherungen nicht mehr in die Ergebniss Tabelle aufgenommen werden und eine Fehlermeldung erscheinen z.b." die maximale Bauteilanzahl wurde erreicht". Die Limitierungen der Bauteile finden sich dabei in Spalte B der Tabelle Limit in spalte a befindet sich der entsprechende Eingabewert für die zuordnung.

Mein Code bisher:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim lngZiel As Long
    Dim varSuche As Variant
    If Not Intersect(Target, Range("D7")) Is Nothing Then
        With Sheets("Ergebnisse")
        lngZiel = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
        End With
        varSuche = Range("D7").Value
        With Sheets("BerechneteTeile")
            Set c = .Columns(32).Find(varSuche, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
            
               ' .Cells(c.Row, 1).Resize(1, 32).Copy Sheets("Ergebnisse").Cells(lngZiel, 1)
               ' .Rows(c.Row).Copy Sheets("Ergebnisse").Cells(lngZiel, 1)
               
            .Rows(c.Row).Copy Sheets("Ergebnisse").Cells(lngZiel, 1)
                Sheets("Ergebnisse").Cells(lngZiel, 33).Value = Range("L7").Value
                Sheets("Ergebnisse").Cells(lngZiel, 34).Value = Range("N10").Value
              
              
              
            MsgBox "Bauteil wurde in die Stückliste aufgenommen"
            
            
            Call Limitierung
            Call Legogesicht


hier als Ausschnitt eine Limitierung

...
If ActiveWorkbook.Sheets("Eingabe").Range("D7") = "500" Then
      If ActiveWorkbook.Sheets("Limit").Range("D29") < 1 Then
    ActiveWorkbook.Sheets("Limit").Range("D29").Value = ActiveWorkbook.Sheets("Limit").Range("D29").Value + 1
      Else: MsgBox ("Sie haben die maximale verwendbare Anzahl dieser Komponente erreicht!")
      End If
   End If
   

Vilen Dank für jeden Hinweis oder Tipp oder Lösungsvorschlag