Sub FindNextHeading() Do Until Left(Selection.Paragraphs(1).Style, 7) = "Heading" Selection.MoveDown Unit:=wdParagraph, _ Count:=1, Extend:=wdMove Loop End Sub