AW: Gesuchte Wort nicht gefunden, weiter laufen..
16.09.2016 05:17:30
Werner
Hallo,
ich verstehe nicht, was du unter "weitermachen" verstehst. Dein Code steigt mit einer Fehlermeldung aus wenn der Suchbegriff "Web" oder der Suchbegriff "Summe Premiumservices" nicht gefunden wird.
Von daher würde ich eher meinen, dass das Makro dann, ggf. mit einem entsprechenden Hinweis, beendet werden sollte.
Derzeit sehe ich nur, dass du "Web" suchst, den Wert 3 Zellen rechts der Fundstelle kopierst, dann "Summe Premiumservices" suchst und den kopierten Wert 3 Zellen rechts von dieser Fundstelle wieder einfügst.
Oder gibt es danach weiteren Code in diesem Modul, den du uns aber vorenthältst?
Option Explicit
Public Sub Suchen_Kopieren()
Dim rngFund As Range
Set rngFund = Cells.Find(What:="Web", After:=Range("A1"), LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rngFund Is Nothing Then
rngFund.Offset(0, 3).Copy
Set rngFund = Cells.Find(What:="Summe Premiumservices", After:=Range("A1"), LookIn:=xlFormulas _
_
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rngFund Is Nothing Then
rngFund.Offset(0, 3).PasteSpecial Paste:=xlValues, Operation:=xlSubtract, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
Application.CutCopyMode = False
Else
MsgBox """Web"" ist nicht vorhanden"
End If
MsgBox "Hier dein Code wenn noch was kommt"
End Sub
Public Sub Suchen_Kopieren1()
Dim rngFund As Range
Set rngFund = Cells.Find(What:="Web", After:=Range("A1"), LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If rngFund Is Nothing Then
MsgBox """Web"" ist nicht vorhanden"
Exit Sub
Else
rngFund.Offset(0, 3).Copy
Set rngFund = Cells.Find(What:="Summe Premiumservices", After:=Range("A1"), LookIn:=xlFormulas _
_
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If rngFund Is Nothing Then
Application.CutCopyMode = False
MsgBox """Summe Premiumservices"" ist nicht vorhanden"
Exit Sub
Else
rngFund.Offset(0, 3).PasteSpecial Paste:=xlValues, Operation:=xlSubtract, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
End If
End Sub
Makro Suchen_Kopieren wenn es weiteren Code gibt der abgearbeitet werden soll (mit der von Hajo vorgeschlagenen If Not rngFund Is Nothing Mehtode).
Makro Suchen_Kopieren1 wenn es keinen weiteren Code gibt (würde ich dann so machen).
Kannst es ja mal ausprobieren.
Gruß Werner