VBA Loop werkt niet

Sub Test2()
Set sht = Worksheets("Calculations")
LastRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row + 1
LastCol = (LastRow - 2) * 3
i = 1
r = 3
c = 5

Do Until r > LastRow
    sht.Cells(r, c).Select
    RangeName = "Airline_" & i
    Set Cell = sht.Cells(r, 5)
    sht.Names.Add Name:=RangeName, RefersTo:=Cell
        Do Until c > LastCol
            RangeName = "Airline_" & i
            Set Cell = Application.Union(Range("Airline_" & i), sht.Cells(r, c))
            sht.Names.Add Name:=RangeName, RefersTo:=Cell
        c = c + 3
        Loop
    i = i + 1
    r = r + 1
Loop

End Sub

Sub hsv()
Dim i As Long, j As Long, c00 As Double
For i = 3 To Application.Max(3, Cells(Rows.Count, 1).End(xlUp).Row)
   For j = 5 To Cells(i, Application.Max(5, Cells(i, Columns.Count).End(xlToLeft).Column)).Column Step 3
     c00 = c00 + Cells(i, j)
   Next j
  Cells(i, 3) = c00
  c00 = 0
 Next i
End Sub