Sub RemoveHeadAndFoot()
Application.ScreenUpdating = False
Dim Sctn As Section, HdFt As HeaderFooter
For Each Sctn In ActiveDocument.Sections
  For Each HdFt In Sctn.Headers
    With HdFt
      If .Exists = True Then .Range.Text = vbNullString
    End With
  Next
  For Each HdFt In Sctn.Footers
    With HdFt
      If .Exists = True Then .Range.Text = vbNullString
    End With
  Next
Next
End Sub