Sub Macro1()
    TagControls "Q1Ans"
End Sub

Sub Macro2()
ReadControls "Q1Ans"
End Sub

Sub TagControls(strTag As String, Optional iStart As Integer = 0)
'Graham Mayor - http://www.gmayor.com - Last updated - 21 Jun 2018
Dim oCC As ContentControl
Dim i As Integer
    For i = 1 To Selection.Range.ContentControls.Count
        Set oCC = Selection.Range.ContentControls(i)
        oCC.Tag = strTag & CStr(i + iStart)
        oCC.Title = strTag & CStr(i + iStart)
        DoEvents
    Next i
lbl_Exit:
    Set oCC = Nothing
    Exit Sub
End Sub

Sub ReadControls(strTag As String)
Dim oCC As ContentControl
Dim oSource As Document
Dim oDoc As Document
    Set oSource = ActiveDocument
    Set oDoc = Documents.Add
    For Each oCC In oSource.ContentControls
        If oCC.Tag Like strTag & "*" Then
            If oCC.ShowingPlaceholderText = False Then
                oDoc.Range.InsertAfter oCC.Range.Text & vbCr
            End If
        End If
        DoEvents
    Next oCC
lbl_Exit:
    Set oCC = Nothing
    Exit Sub
End Sub