Dim wpsActive As Document
Dim wpsNew As Document
Dim styleLoop As Style
Set wpsActive = ActiveDocument
Set wpsNew = Documents.Add
For Each styleLoop In wpsActive.Styles
With wpsNew.Range
.InsertAfter Text:=styleLoop.NameLocal
& Chr(9) & styleLoop.Description
.InsertParagraphAfter
End With
Next styleLoop