remove all animations

My colleague Laura Den produces wonderful powerpoints but I find them a bit heavy on the animations. I run the following macro over them to remove all animations and I add back just a few.

Sub RemoveAllAnimations()

Dim sld As Slide
Dim x As Long
Dim Counter As Long

For Each sld In ActivePresentation.Slides
    
For x = sld.TimeLine.MainSequence.Count To 1 Step -1
        
sld.TimeLine.MainSequence.Item(x).Delete
        
Counter = Counter + 1
          
Next x
   
Next sld

End Sub