Sub AktualisiereMasters() 
Dim ppt As Presentation, fm As Master, sh As Shape 
Dim col As Collection 
Dim cFile As String, Pfad As String 
Dim i As Integer 
 
Set col = New Collection 
 
Pfad = "xyz\" 'der Pfad zu allen PPTs mit abschließendem Backslash(keine Unterverzeichnisse) 
cFile = Dir(Pfad & "*.pptx") ' Alle PPTs im Verzeichnis ausgeben 
Do While cFile <> "" ' Wiederholen bis cFile="" 
  col.Add Pfad & cFile 
  cFile = Dir ' Aufruf der Funktion ohne Parameter!! 
Loop 
 
For i = 1 To col.Count 
    Set ppt = Presentations.Open(col(i)) 
    Set fm = ppt.SlideMaster 
    For Each sh In fm.Shapes 
        If sh.TextFrame.TextRange.Text = blabla Then 'Irgendetwas, womit Du diese Shapes identifizieren kannst 
            sh.Delete 
        End If 
    Next sh 
Next i 
 
End Sub