VBA finden und Suchen einfügen Werte

Question

Ich habe dieses Blatt, wo ich Find und FindNext verwenden möchten für Werte auf einem anderen Blatt suchen BD und kopieren Sie sie in meine Großschot Plan1, wenn der Wert auf alocacao Streichhölzer Zellen auf Column 5.

Ich hatte 4 Felder mit benannten Bereichen tecnico1, tecnico2, tecnico3 and tecnico4, um die Werte einzufügen und der Code funktioniert gut.

Dies ist, wie es aussieht:

Und das BD Blatt:

Und das ist der Code:

Sub VerifProd_Click() 
    Dim FoundCell As Range, FirstAddr As String, fnd As String, i As Long 

    fnd = Sheets(1).Range("alocacao").Value 

    Set FoundCell = Sheets("BD").Columns(5).Find(what:=fnd, _ 
     After:=Sheets("BD").Cells(Rows.Count, 5), Lookat:=xlPart, _ 
     LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext) 

    If FoundCell Is Nothing Then Exit Sub 

    Do 
     i = i + 1 
     Sheets("Plan1").Range("tecnico" & i).Value = FoundCell.Offset(, -3).Value 
     Sheets("Plan1").Range("upps0" & i).Value = FoundCell.Offset(, -1).Value 

     Set FoundCell = Sheets("BD").Columns(5).FindNext(After:=FoundCell) 
    Loop Until FoundCell.Address = FirstAddr Or i >= 4 
End Sub 

Aber jetzt ich Erkenne, dass ich mehr Felder brauche e Ich kann vielleicht mehr als 4 tecnicos auf einem alocacao einfügen. So, jetzt ist dies, wie es aussieht:

Und ich gerade diesen Teil des Codes geändert:

If FoundCell Is Nothing Then Exit Sub 

     Do 
      i = i + 1 
      Sheets("Plan1").Range("tecnico" & i).Value = FoundCell.Offset(, -3).Value 
      Sheets("Plan1").Range("upps0" & i).Value = FoundCell.Offset(, -1).Value 

      Set FoundCell = Sheets("BD").Columns(5).FindNext(After:=FoundCell) 
     Loop Until FoundCell.Address = FirstAddr Or i >= 10 

Also ich hatte erwartet, dass es füllt nur 4 Felder wie ich nur noch 4 Streichhölzer, aber ich habe dieses Ergebnis:

Da ich neu bin mit Suchen und Suchen, ich weiß wirklich nicht, was ich muss geändert werden, um die Zellen nur mit den Übereinstimmungen zu füllen, ohne sie zu wiederholen.

Alle Vorschläge helfen! Vielleicht ist da etwas, was ich dort nicht bemerken konnte.

Answer 1

Ich habe nur den Vorschlag von @Luuklag verwendet und jetzt funktioniert es.

Sub VerifProd_Click() 
    Dim FoundCell As Range, FirstAddr As String, fnd As String, i As Long 

    fnd = Sheets(1).Range("alocacao").Value 

    Set FoundCell = Sheets("BD").Columns(5).Find(what:=fnd, _ 
     After:=Sheets("BD").Cells(Rows.Count, 5), Lookat:=xlPart, _ 
     LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext) 

    If Not FoundCell Is Nothing Then 
     FirstAddr = FoundCell.Address 
    End If 
    If FoundCell Is Nothing Then Exit Sub 

    Do 
     i = i + 1 
     Sheets("Plan1").Range("tecnico" & i).Value = FoundCell.Offset(, -3).Value 
     Sheets("Plan1").Range("upps0" & i).Value = FoundCell.Offset(, -1).Value 

     Set FoundCell = Sheets("BD").Columns(5).FindNext(After:=FoundCell) 
    Loop Until FoundCell.Address = FirstAddr Or i >= 10 
End Sub