Private Sub Worksheet_SelectionChange(ByVal Target As Range) For Each c In Shapes c.Delete Next Set myDocument = Worksheets(1) For i = 2 To 15 For j = 2 To 10 If Cells(i, j) <> "" Then m = Cells(i, j).Left + Cells(i, j).Width / 2 n = Cells(i, j).Top + Cells(i, j).Height / 2 If x <> "" And y <> "" Then With myDocument.Shapes.AddLine(x, y, m, n).Line .ForeColor.RGB = RGB(255, 0, 0) End With End If x = m y = n End If Next Next End Subtest.zip (8.95 KB)