Sub iFirstLast()
Dim i As Long
Dim iLastRow As Long
Dim j As Integer
Dim iLastCol As Integer
 iLastCol = Cells(2, Columns.Count).End(xlToLeft).Column
 iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
 Range("C3:D" & iLastRow).ClearContents
  For i = 3 To iLastRow
    For j = 5 To iLastCol
      If WorksheetFunction.CountA(Range(Cells(i, 5), Cells(i, iLastCol))) >= 2 Then   'есть первая м последняя выплата
        If Cells(i, j) <> "" Then
          Cells(i, "C") = Cells(2, j)   'первая выплата
          Do
            j = j + 1
            If Cells(i, j) <> "" Then Cells(i, "D") = Cells(2, j)
          Loop While j < iLastCol + 1
        End If
      Else      'одна выплата
        If Cells(i, j) <> "" Then
          Cells(i, "C") = Cells(2, j)   'первая выплата
        End If
      End If
    Next
  Next
End Sub

Function Max_Min_Data(DiapDat As Range, DiapSum As Range, Optional Max_Min% = 1) As Double
Dim Ar1, Ar2
Ar2 = DiapDat.Value: Ar1 = DiapSum.Value
For i = 1 To UBound(Ar1, 2)
If Ar1(1, i) <> "" Then Ar1(1, i) = VBA.CDbl(Ar2(1, i))
Next i
If Max_Min = 0 Then Max_Min_Data = WorksheetFunction.Min(Ar1) Else Max_Min_Data = WorksheetFunction.Max(Ar1)
End Function

Function Max_Min_Data(DiapDat As Range, DiapSum As Range, Optional Max_Min% = 1)
Dim Ar1, Ar2

Max_Min_Data = ""

If WorksheetFunction.Sum(DiapSum) > 0 Then
Ar2 = DiapDat.Value: Ar1 = DiapSum.Value
For i = 1 To UBound(Ar1, 2)
If Ar1(1, i) <> "" Then Ar1(1, i) = VBA.CDbl(Ar2(1, i))
Next i
If Max_Min = 0 Then Max_Min_Data = WorksheetFunction.Min(Ar1) Else Max_Min_Data = WorksheetFunction.Max(Ar1)
End If
End Function

=ИНДЕКС($E$2:$N$2;ПОИСКПОЗ(1=0;E3:N3="";0))
или
=ИНДЕКС($E$2:$N$2;ПОИСКПОЗ(1=1;E3:N3>0;0))