Sub EditStyleSpaces()
Application.ScreenUpdating = False
Dim strStyles As String, i As Long
strStyles = "Style1,Style2,Style3,Style4"
With ActiveDocument.Content.Find
  .ClearFormatting
  .Format = True
  .Replacement.Text = "   "
  .MatchWildcards = True
  .Wrap = wdFindContinue
  For i = 0 To UBound(Split(strStyles, ","))
    .Style = Split(strStyles, ",")(i)
    .Text = "[ ]{2,4}"
    .Execute Replace:=wdReplaceAll
    .Text = "^t"
    .Execute Replace:=wdReplaceAll
  Next i
End With
Application.ScreenUpdating = True
End Sub