Sub run_1()
    Dim i&, k&, j&, lc
    k = 1
    b = ActiveSheet.UsedRange.Rows("2:3")
    lc = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
    For j = k To lc
        If Not IsEmpty(b(1, j)) And IsNumeric(b(1, j)) Then k = j: Exit For
    Next
    If Not IsEmpty(b(1, k + 1)) And IsNumeric(b(1, k + 1)) Then
        With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, b(1, k), b(2, k))
            For i = k + 1 To lc
              If Not IsEmpty(b(1, i)) Then .AddNodes msoSegmentLine, msoEditingAuto, b(1, i), b(2, i)
                Next i
            .ConvertToShape
            End With
    End If

Sub Âàðèàíò_1()
    Dim i&, k&, j&
    k = 1
    b = ActiveSheet.UsedRange.Rows("2:3")
Nach:
    For j = k To UBound(b, 2)
        If Not IsEmpty(b(1, j)) And IsNumeric(b(1, j)) Then k = j: Exit For
    Next
    If Not IsEmpty(b(1, k + 1)) And IsNumeric(b(1, k + 1)) Then
        With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, b(1, k), b(2, k))
            For i = k + 1 To UBound(b, 2)
                .AddNodes msoSegmentLine, msoEditingAuto, b(1, i), b(2, i)
                If i = UBound(b, 2) Then Exit For
                Do While IsEmpty(b(1, i + 1))
                    k = i + 1
                    i = i + 1
                Loop
            Next
            .ConvertToShape
            'If k < UBound(b, 2) Then GoTo Nach
        End With
    End If
End Sub