Habe ein Makro,das mir im Bereich A1:O63 nach Text sucht & ersetzt.
Leider bleibt das Makro nach dem ersten ersetzten Wert stehen.
Könnte mir bitte jemand weiterhelfen?
Gruß Heinz
Option Explicit
Sub Englisch()
Dim Suchtext As Variant
Dim Ersatztext As Variant
Dim Bereich As Range
Dim Suche As Range
Dim LSuchtext As Integer 'Länge vom Suchtext
Dim LGesamt As Integer 'Länge vom genazen Text der Fundzelle
Dim LRest As Integer 'Wie LGesamt, aber exklusive Suchtext
Dim FundAnzahl As Integer
Dim i As Long
Suchtext = "Abdecktray"
Ersatztext = "Cover tray"
Suchtext = "BEZEICHNUNG"
Ersatztext = "TITLE"
Suchtext = "Artikelhöhe"
Ersatztext = "Height of article"
Suchtext = "VERPACKUNGSPLANNR."
Ersatztext = "PACKAGING PLAN NUMBER"
Suchtext = "SAP-NR."
Ersatztext = "SAP-NO."
Suchtext = "FARBE :"
Ersatztext = "COLOR:"
Suchtext = "MÜNDUNG :"
Ersatztext = "MOUTH:"
Suchtext = "Artikeldurchmesser "
Ersatztext = "Diameter of article"
Suchtext = "Artikelgewicht (lt. Zeichn.)"
Ersatztext = "Weight of article (acc. drawing)"
LSuchtext = Len(Suchtext)
Set Bereich = Range("A1:O63") 'zu suchenden Bereich festlegen
Set Suche = Bereich.Find(What:=Suchtext, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
If Suche Is Nothing Then
MsgBox "Keine übereinstimmende Daten gefunden!"
Else
Application.ScreenUpdating = False
Do
LGesamt = Len(Suche.Value)
LRest = Len(Replace(Suche.Value, Suchtext, "", , , vbTextCompare))
FundAnzahl = (LGesamt - LRest) / LSuchtext
i = i + FundAnzahl
Application.StatusBar = "Ersetzung in: " & Suche.Address
Suche.Value = Replace(Suche.Value, Suchtext, Ersatztext, , , vbTextCompare)
Set Suche = Bereich.FindNext(Suche)
Loop Until Suche Is Nothing
Application.ScreenUpdating = True
MsgBox "Es wurden " & i & " Ersetzungen durchgeführt!"
End If
Application.StatusBar = False
Set Bereich = Nothing
Set Suche = Nothing
End Sub