Dir hilft die Range.Find-Methode. Im Link findest Du unten auch ein Beispiel, wie man per Schleife und .FindNext-Methode durch die Fundstellen hoppelt.
Ich schaue heute Abend wieder rein. Dann dürfte ich auch Zeit finden, mal flugs einen Code zu schreiben.
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:1 Nutzer sagt Danke an RPP63 für diesen Beitrag 28 • stepcke
Hier ein copy/paste Lösung, zum Testen habe ich ein neues Sheets("Test") eingfügt:
Code:
Sub F_en() Dim rng As Range, iAdr As Range, Anf As Range
such = "Tel:" Set Anf = Cells(2, 1) With Sheets("Quelle").Columns(1) Set rng = .Find(such, , xlValues, xlPart) adr = rng.Address Do rng.Interior.Color = vbYellow Set iAdr = Range(Anf, rng) Tx = Application.Transpose(iAdr) If UBound(Tx) = 3 Then Tx(1) = Tx(1) & "|" lr = lr + 1 Sheets("Test").Cells(lr, 1) = Join(Tx, "|") Set Anf = rng.Offset(1) Set rng = .FindNext(rng) Loop Until rng.Address = adr End With End Sub
Danach fehlt noch ein "Text-in_Spalten".
Folgende(r) 1 Nutzer sagt Danke an Fennek für diesen Beitrag:1 Nutzer sagt Danke an Fennek für diesen Beitrag 28 • stepcke