Bitte Script für Arbeitsmappe anpassen

Sub Aufmassdaten()
Dim wks As Worksheet
Dim rng As Range
Dim iRowL As Integer, iRow As Integer
Dim tarWks As Worksheet
Set tarWks = Worksheets("Rechnung")
For Each wks In Sheets(Array("Vorbereitung", "Aufmass"))
With wks
iRowL = tarWks.Cells(.Rows.Count, 1).End(xlUp).Row
For iRow = 8 To iRowL
If Not IsEmpty(tarWks.Cells(iRow, 1)) Then
Set rng = .Cells.Find(tarWks.Cells(iRow, 1), _
lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing Then
For iSpalte = 1 To 3
tarWks.Cells(iRow, iSpalte).Value = .Cells(rng.Row, iSpalte).Value
If .Cells(rng.Row, iSpalte).Font.Bold = True Then
tarWks.Cells(iRow, iSpalte).Font.Bold = True
Else
tarWks.Cells(iRow, iSpalte).Font.Bold = False
' Fetten Text im Inhalt bestimmen und in Zielzelle formatieren
iFettStart = 0
iFettEnde = 0
i = 0
Do Until i = Len(.Cells(rng.Row, iSpalte).Value)
i = i + 1
If iFettStart = 0 And .Cells(rng.Row, iSpalte).Characters(Start:=i, Length:=1).Font.FontStyle = "Fett" Then
iFettStart = i
Else
If iFettStart > 0 And .Cells(rng.Row, iSpalte).Characters(Start:=i, Length:=1).Font.FontStyle <> "Fett" Then
iFettEnde = i
tarWks.Cells(iRow, iSpalte).Characters(Start:=iFettStart, Length:=iFettEnde - iFettStart).Font.FontStyle = "Fett"
iFettStart = 0
iFettEnde = 0
End If
End If
Loop
If iFettStart > 0 And iFettEnde = 0 Then 'Text ist bis zum Ende Fett
tarWks.Cells(iRow, iSpalte).Characters(Start:=iFettStart, Length:=i + 1 - iFettStart).Font.FontStyle = "Fett"
End If
End If
Next iSpalte
End If
End If
Next iRow
End With
Next wks
End Sub