Have you step debugged and examined content of variables as code executes? Use Debug.Print to examine variables at critical steps in code. Use Watch window.
Try this following the For Each line:
Debug.Print i & " : " & k
Examine output in the Immediate Window.
After couple hours of testing, this produces desired output from given sample:
Sub Macro1()
Dim i, k, blanks, counter
i = 1
For Each k In ActiveDocument.Words
If InStr(k, "__") > 0 And InStr(k, "*") = 0 Then
k.Select
If (i Mod 2) = 0 Then
blanks = ""
For counter = 1 To Len(Trim(k)) - 1
blanks = blanks & "__*" & IIf(InStr(k, " ") > 0, " ", "")
Next counter
Word.Selection.TypeText blanks
End If
If InStr(k, "*") = 0 Then i = i + 1
End If
Next k
End Sub