Sub Tablica()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
  With Worksheets("Лист2")
   iLR = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
   .Range("B5:D" & iLR).Clear
     iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
    For i = 2 To iLastRow
      iLR = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
      .Cells(iLR, "B") = i - 1
      .Cells(iLR, "C") = Cells(i, "B")
      .Cells(iLR, "D") = Cells(i, "C")
      .Range("B" & iLR & ":D" & iLR).Borders.Weight = xlThin
    Next
      .Cells(iLR + 2, "C") = "ИТОГО: "
      .Cells(iLR + 2, "C").HorizontalAlignment = xlRight
      .Cells(iLR + 2, "D") = WorksheetFunction.Sum(.Range("D5:D" & iLR))
      .Cells(iLR + 2, "D").Font.Bold = True
      .Activate
  End With
End Sub