Sub ITALICS()
    For Each myRng In ActiveDocument.StoryRanges
        Do
            With myRng
                Do
                    With .Find
                    .MatchWildcards = False
                    .text = ""
                    .Replacement.text = ""
                    .Font.Italic = True
                    .Wrap = wdFindStop
                    .Execute
                    End With
                    If .Find.found Then
                        MsgBox myRng.text
'Replace with Style:
                        myRng.Style = "Italic"
                    Else: Exit Do
                    End If
                    myRng.Collapse 0
                Loop
            End With
            Set myRng = myRng.NextStoryRange
        Loop Until myRng Is Nothing
    Next myRng
End Sub