Kopieren von Daten die dem Suchkriterium entsprech

Bild

Betrifft: Kopieren von Daten die dem Suchkriterium entsprech
von: Manuel
Geschrieben am: 05.11.2015 14:00:56

Hallo liebe Forumsmitglieder,
ich versuche mit meinem Code alle Zeilen zu übernehmen, die dem Suchkred entsprechen. Ist das Suchkriterium gleich dem was in der Tabelle steht, soll die ganze Zeile (A-D) übernommen werden. Bei meinem Makro wird aber immer nur die erste übernommen, danach passiert nichts mehr. Könnt ihr mir sagen was ich verändern muss?

Sub Laden_Bewertung()
    Dim Fuell_Arbeitsblatt As String
    Dim zBedingung As String
    Suchkred = Sheets("Daten_Informationen").Range("A1").Value
    
    Application.ScreenUpdating = False
    
    'Fuell_Arbeitsblatt = ActiveSheet.Name
    
    'Arbeitsblatt entsperren
    Sheets("Diagram").Unprotect
    Sheets("Daten_Informationen").Unprotect
   ' Sheets("Stabilusbewertung").Unprotect
    
    
    NumRows = Get_Anzahl_Zeilen1("Daten_Informationen")
    NumRows = NumRows + 1
    
   ' Sheets(Fuell_Arbeitsblatt).Activate
    DatenZeile = 2
    Do While DatenZeile < NumRows
    
        If (Trim(CStr(Sheets("Daten_Informationen").Cells(DatenZeile, 1).Value))) = Suchkred  _
Then
            
            'Name des Teils mit verstecktem Wert, da in weißer Schrift
            Sheets("Diagram").Cells(DatenZeile, 1) = Trim(CStr(Sheets("Daten_Informationen"). _
Cells(DatenZeile, 1).Value))
            Sheets("Diagram").Cells(DatenZeile, 2) = Trim(CStr(Sheets("Daten_Informationen"). _
Cells(DatenZeile, 2).Value))
            Sheets("Diagram").Cells(DatenZeile, 3) = Trim(CStr(Sheets("Daten_Informationen"). _
Cells(DatenZeile, 3).Value))
            Sheets("Diagram").Cells(DatenZeile, 4) = Trim(CStr(Sheets("Daten_Informationen"). _
Cells(DatenZeile, 4).Value))
            'Info über die geschlossenen Eigenschaften
            
                   
   '                 zBedingung = Get_Zahlungstext(zBedingung)
                    ZahlungText(i) = zBedingung
   '             End If
   '         Next i
   
                Exit Do
            
            End If
        
            DatenZeile = DatenZeile + 1
            
        Loop
End Sub

Vielen Dank und liebe Grüße

Bild

Betrifft: AW: Kopieren von Daten die dem Suchkriterium entsprech
von: matthias
Geschrieben am: 05.11.2015 14:10:58
Hallo Manuel,
das "Exit Do" gehört dann sicher nicht dahin. Gönn' dir noch 'nen Kaffee.
lg Matthias

Bild

Betrifft: AW: Kopieren von Daten die dem Suchkriterium entsprech
von: Manuel
Geschrieben am: 05.11.2015 15:52:48
Okay danke für den Tipp, es funktioniert allerdings noch nicht... . Hast du noch einen anderen?

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Kopieren von Daten die dem Suchkriterium entsprech"