how to move 2 text from a paragraph to a object

i have this code that can move 1 text from a paragraph and move to grouped object. Does anyone can help to move 2 text from a paragraph to a grouped object.


Sub text_paras_to_shapes()
Dim sr1_index As Long
Dim sr1 As ShapeRange
Dim sr2 As New ShapeRange
Dim sr3 As New ShapeRange
Dim para_count As Long
Dim counter_1 As Long
Dim s2 As Shape
Dim tr As TextRange

    Optimization = True
    ActiveDocument.BeginCommandGroup "text paras to shapes"
    EventsEnabled = False
    On Error GoTo ErrHandler
       
    Set sr1 = ActiveSelectionRange
    If sr1.Count = 0 Then
        MsgBox "Nothing is selected."
    GoTo ExitSub
    End If
    
    sr1_index = 1
    Do
        If sr1(sr1_index).Type = cdrTextShape Then
            sr2.Add sr1(sr1_index)
            sr1.Remove (sr1_index)
        End If
        sr1_index = sr1_index + 1
    Loop Until sr1_index > sr1.Count
    
    If sr2.Count = 0 Then
        MsgBox "No text shape was found in the selection."
        GoTo ExitSub
    Else
        If sr2.Count > 1 Then
            MsgBox "More than one text shape was found in the selection."
            GoTo ExitSub
        End If
    End If
    
    para_count = sr2(1).Text.Story.Paragraphs.Count
    If para_count > sr1.Count Then
        MsgBox "The number of paragraphs in the text shape (" & para_count & ") is more than the number of rectangles (" & sr1.Count & ") in the selection."
        GoTo ExitSub
    End If
        
    sr1.Sort "@shape1.top>@shape2.top"
    
    For counter_1 = 1 To para_count
        Set tr = sr2(1).Text.Story.Paragraphs(counter_1)
        Set s2 = ActiveDocument.ActiveLayer.CreateArtisticText(0, 0, tr.Text, , , tr.Font, tr.Size, tr.Bold, tr.Italic, tr.Underline)
        s2.Fill = tr.Fill
        s2.CenterX = sr1(counter_1).CenterX
        s2.CenterY = sr1(counter_1).CenterY
        sr3.RemoveAll
        sr3.Add s2
        sr3.Add sr1(counter_1)
        sr3.Group
    Next counter_1
    
    ActiveSelection.Shapes.All.RemoveFromSelection

ExitSub:
    Optimization = False
    EventsEnabled = True
    Application.Refresh
    ActiveDocument.EndCommandGroup
    Exit Sub

ErrHandler:
    MsgBox "Error occurred: " & Err.Description
    Resume ExitSub
End Sub