suche findet nur einen und hört dann auf

hallo ich habe folgendes problem:
ich habe ein makro das verschiedene nummern aus einer webseite die importiert wird auslesen soll nur wird nur die erste ausgelesen und weitergegeben das funktioniert auch größtenteils mein problem ist jetzt das auch mehrere nummern auf der seite sein können und ich diese finden und ausgeben muss - hat jemand ne lösung?
hier das makro:


Sub BearbeiteN_Page1(Kartenname, DsccString, Path, nemoNSNS)
' Neue Karteikarten anlegen
Set Karte = Worksheets.Add
Karte.Name = "Kartenname"
'  Neue Tabelle lesen
Read_Web_Wait_Page1 Karte, DsccString, "A1"
' Nach N suchen
Cells.Find(What:="N Number", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
Nnumber = Right(ActiveCell.Value, 13)
Nnumber = Left(Nnumber, 4) & "-" & Mid(Nnumber, 5, 2) & "-" & Mid(Nnumber, 7, 3) & "-" & Mid(Nnumber, 10, 4)
' N in Datei schreiben
Print #1, Nnumber
' Worksheet schließen
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End Sub

vielen dank schonmal für eure tips und anregungen
gruß frank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub BearbeiteN_Page1(Kartenname, DsccString, Path, nemoNSNS) Dim rng As Range ' Neue Karteikarten anlegen Set Karte = Worksheets.Add Karte.Name = "Kartenname" ' Neue Tabelle lesen Read_Web_Wait_Page1 Karte, DsccString, "A1" ' Nach N suchen Set rng = Cells.Find(What:="N Number", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) Nnumber = Right(rng.Value, 13) Nnumber = Left(Nnumber, 4) & "-" & Mid(Nnumber, 5, 2) & "-" & Mid(Nnumber, 7, 3) & "-" & Mid(Nnumber, 10, 4) ' N in Datei schreiben Print #1, Nnumber Do ' Nach N suchen Set rng = Cells.FindNext If Not rng Is Nothing Then Nnumber = Right(rng.Value, 13) Nnumber = Left(Nnumber, 4) & "-" & Mid(Nnumber, 5, 2) & "-" & Mid(Nnumber, 7, 3) & "-" & Mid(Nnumber, 10, 4) ' N in Datei schreiben Print #1, Nnumber End If Loop Until rng Is Nothing ' Worksheet schließen Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True End Sub

Sub test() Dim Found As Range Dim FFirst As String ' Nach N suchen Set Found = Cells.Find(What:="N Number", LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not Found Is Nothing Then FFirst = Found.Address Do While Not (Found Is Nothing) Nnumber = Right(Found.Value, 13) Nnumber = Left(Nnumber, 4) & "-" & Mid(Nnumber, 5, 2) & "-" & Mid(Nnumber, 7, 3) & "-" & Mid(Nnumber, 10, 4) ' N in Datei schreiben Print #1, Nnumber Set Found = Cells.FindNext(after:=Found) If Found.Address = FFirst Then Exit Do Loop End Sub

Beliebteste Forumthreads (12 Monate)

suche findet nur einen und hört dann auf

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread