Text Suchen und unterhalb Einfügen
12.01.2024 07:21:00
Michael_79
das ist nahezu perfekt. Danke sehr, das ist die 98% Lösung. ;)
Gerne möchte ich es deswegen nochmal aufgreifen.
Vielleicht kannst du da noch etwas unterstützen. Das Problemchen ist, dass der Text der eingefügt werden soll, dem gesuchten Text gleicht, lediglich die neben Zeilen haben andere Werte. (der gesuchte Eintrag ist in den Arbeitsblättern entweder 1x oder garnicht vorhanden)
D.h. in der Paxis, wenn ich den einzufügenden Text in der Tabelle eingebe, wird er auch gefunden und anschließend ca. 9999999...x eigefügt.
hier noch mal dein Code:
Sub test()
Dim sh As Worksheet
Dim WAS As String
Dim FirstFound As String
Dim c As Range
Dim EinfügeZeile As Range
Set EinfügeZeile = Sheets("RSV_022_00005").Rows(70) 'Zeile, die eingefügt werden soll
EinfügeZeile.Copy
WAS = "Käsebrot"
For Each sh In ActiveWindow.SelectedSheets
With sh
Set c = .Cells.Find(what:=WAS, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
FirstFound = c.Address
Do
EinfügeZeile.Copy
.Rows(c.Row + 1).Insert
Set c = .Cells.FindNext(c)
Loop Until c.Address = FirstFound
End If
End With
Next
End SubLässt sich die Suche evtl. auf nur den "Ersten Treffen" begrenzen, oder so was in der Art, dass es pro Arbeitsbaltt auch nur 1x eigefügt wird.
Auch nochmals danke an Yal für die Unterstützung und Geduld.
Grüße
Michael