Sub ReplaceQuestionID()
    Dim i As Long
    i = 1
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .text = "{Question ID}"
        .Replacement.text = ""
        .Forward = True
        .Wrap = wdFindStop
        While .Execute
            Selection.text = "{Question ID}" & i
            i = i + 1
            Selection.Collapse wdCollapseEnd
        Wend
    End With
End Sub

Sub ReplaceQuestionIDMacroJSON()
    Dim i As Long
    
    For i = 1 To 40
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .text = "{Question ID}" & i
        .Replacement.text = ""
        .Forward = True
        .Wrap = wdFindStop
        .MatchWholeWord = True
        
        While .Execute
            Selection.text = Chr(34) & i & Chr(34) & ":{"
            Selection.Collapse wdCollapseEnd
        Wend
    End With
    Next i
End Sub