rngFind Problem
08.06.2020 11:59:18
Mike
ich habe leider ein Problem mit meinem Code und hoffe jemand kann mir da weiterhelfen.
Kurze Erläuterung: Ich habe 2 Tabellen in einem Workbook. In der ersten Tabelle (Beispieldatei) habe ich einen Suchbegriff (Auftragsnummer, z.B. 100) hinterlegt. Nun soll in der zweiten Tabelle (Rohdaten) geprüft werden, ob der Suchbegriff dort vorhanden ist. Wenn dieser vorhanden ist, sollen einige Infos aus der Tabelle "Rohdaten" in die Tabelle "Beispieldatei" übernommen werden.
Dies funktioniert bislang auch. Allerdings wird nur die erste Zeile in "Rohdaten" auf Übereinstimmung mit dem Suchbegriff aus "Beispieldatei" geprüft. Danach passiert nichts mehr. Es wird nicht weiter geprüft, ob der Suchbegriff eine Zeile weiter auftaucht. Ich weiß nicht wieso.
Hoffe ihr könnt mir da weiterhelfen.
Option Explicit
Public Sub Datenübernahme()
Dim objSource As Worksheet, objTarget As Worksheet
Dim rngFind As Range, rngTarget As Range
Dim strFirst As String
Dim varSearch As Variant
Set objSource = ThisWorkbook.Sheets("Beispieldatei")
Set objTarget = ThisWorkbook.Sheets("Rohdaten")
varSearch = objSource.Range("A5")
Set rngFind = objSource.Range("A5").Find(What:=varSearch, LookAt:=xlWhole, LookIn:=xlValues)
Set rngTarget = objTarget.Range("B22")
If Not rngFind Is Nothing Then
strFirst = rngFind.Address
If rngFind = objTarget.Range("B22") Then 'Die Prüfung funktioniert.
Do
objTarget.Range("G22").Copy
objSource.Range("E24").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Set rngFind = objSource.Range("A5").FindNext(rngFind)
Loop While Not rngFind Is Nothing And strFirst rngFind.Address
End If
If rngFind = objTarget.Range("B23") Then 'Die Prüfung funktioniert nicht mehr.
Do
objTarget.Range("G22").Copy
objSource.Range("E24").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Set rngFind = objSource.Range("A5").FindNext(rngFind)
Loop While Not rngFind Is Nothing And strFirst rngFind.Address
End If
'Ende-Do-Schleife ------------------------------------------------------------------------------ _
End If
End Sub
Anzeige