get list a spesicif style text

[Mehmetbukum]

The sentences written in the Arabic alphabet marked in the photo were created with the style called "farsca_cumle". Is it possible to list only the sentences defined with this style at the end of the active Document?

this code cant work well

sub listit()
Dim isfound As Boolean
Dim i As Integer
i = 1
Selection.Find.Style = ActiveDocument.Styles("farsca_cumle")
With Selection.Find
    .Text = ""
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
isfound = True
While isfound
    With Selection.Find
        .Execute
        If .Found = True Then
                ActiveDocument.Content.InsertAfter Text:=i & " " & Selection.Text
                i = i + 1
            Selection.MoveRight Unit:=wdCharacter, Count:=1
        Else
                 isfound = False
        End If
    End With
Wend
End sub

[#2]

@Mehmetbukum Try using

Dim RngFound As Range, DocRange As Range
Set DocRange = ActiveDocument.Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = "farsca_cumle"
With Selection.Find
    Do While .Execute(FindText:="", MatchWildcards:=False, Wrap:=wdFindContinue, Forward:=True) = True
        Set RngFound = .Selection.Range
        If RngFound.End < DocRange.End Then
            ActiveDocument.Range.InsertAfter RngFound.Text & vbCr
            Selection.Collapse wdCollapseEnd
        Else
            Exit Sub
        End If
    Loop
End With

[#3]

@Doug_Robbins_Word_MVP unfortunately the code gave an error at "Set RngFound = .Selection.Range"

error: method or data member not found

[#4]

i think before the loop (do while - loop) starts, it should go to the beginning of the document and when the end of the document is reached, the loop should be terminated. Otherwise, it will enter an infinite loop. we must edit code

[#5]

@Mehmetbukum Sorry, the code should have been

Dim RngFound As Range, DocRange As Range
Set DocRange = ActiveDocument.Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = "farsca_cumle"
With Selection.Find
    Do While .Execute(FindText:="", MatchWildcards:=False, Wrap:=wdFindContinue, Forward:=True) = True
        Set RngFound = Selection.Range
        If RngFound.End < DocRange.End Then
            ActiveDocument.Range.InsertAfter RngFound.Text & vbCr
            Selection.Collapse wdCollapseEnd
        Else
            Exit Sub
        End If
    Loop
End With

This If...then...Else...EndIf construction will cause the code to terminate when it comes to the end of the original text in the document

If RngFound.End < DocRange.End Then
     ActiveDocument.Range.InsertAfter RngFound.Text & vbCr
     Selection.Collapse wdCollapseEnd
Else
     Exit Sub
End If

[#6]

When i run the code, it goes into an infinite loop and crashes the word software.

[#7]

@Mehmetbukum Use

Dim RngFound As Range, DocRange As Range, DocRangeOriginal As Range
Dim i As Long, j As Long
Set DocRange = ActiveDocument.Range
i = DocRange.Paragraphs.Count
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = "farsca_cumle"
With Selection.Find
    Do While .Execute(FindText:="", MatchWildcards:=False, Wrap:=wdFindStop, Forward:=True) = True
        Set RngFound = Selection.Range
        If RngFound.End < DocRange.End Then
            ActiveDocument.Range.InsertAfter RngFound.Text & vbCr
            Selection.Collapse wdCollapseEnd
        Else
            Exit Sub
        End If
    Loop
End With
j = DocRange.Paragraphs.Count
DocRange.Select
Selection.Collapse wdCollapseEnd
Selection.MoveStart wdParagraph, i - j
Selection.Style = "farsca_cumle"

I have added code to format the text added to the end of the document in "farsca_cumle" style.