Sub LoopThruShapes() Dim sh As Shape Dim I As Integer I = 1 For Each sh In ActiveSheet.Shapes If sh.Type = msoLine Then Cells(I, 1).value = sh.name I = I + 1 End If Next End Sub