Option Explicit
Public Sub sucheP()
Dim sAlltext As String, found As String
Dim s As Long, erg As Double
Dim liste As String
sAlltext = ActiveDocument.Content
s = 1
erg = 0
liste = ""
Do
s = InStr(s, sAlltext, "(", vbTextCompare)
If s = 0 Then Exit Do
If InStr(Mid(sAlltext, s, 7), "P)") > 0 Then
found = Mid(Mid(sAlltext, s, 7), 2, InStr(Mid(sAlltext, s, 7), "P)") - 2)
s = s + InStr(Mid(sAlltext, s, 7), "P)")
erg = erg + CDbl(found)
liste = liste & found & vbCr
Else: s = s + 1
End If
Loop Until s = 0
MsgBox ("Punkte: " & erg & vbCr & vbCr & "Liste in der Zwischenablage!")
Dim IE As Object
Set IE = CreateObject("HTMLfile")
IE.ParentWindow.ClipboardData.SetData "text", liste & vbNullString
Set IE = Nothing
End Sub