Sub SelectSum()
    Dim n As Long
    n = Range("D1").Value
    
    Dim y As Long
    y = Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim arr As Variant
    arr = Range(Cells(1, 1), Cells(y, 2))
    
    Dim r As Range
    Dim sm As Long
    For y = 2 To UBound(arr, 1)
        If sm + arr(y, 1) <= n Then
            sm = sm + arr(y, 1)
            If r Is Nothing Then
                Set r = Cells(y, 1)
            Else
                Set r = Union(r, Cells(y, 1))
            End If
            If sm = n Then Exit For
        End If
    Next
    
    If Not r Is Nothing Then
        r.Select
        
        'Формула суммы.
        ReDim arr(1 To r.Areas.Count)
        y = 0
        Dim v As Variant
        For Each v In r.Areas
            y = y + 1
            arr(y) = v.Address(0, 0)
        Next
        Range("E1").Formula = "=SUM(" & Join(arr, ",") & ")"
    End If
End Sub