VBA Do-Schleife funktioniert nicht

Question

ich folgende Do Schleife erstellt:

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 

Auf den ersten Blick scheint alles in Ordnung zu sein. Aber wenn r 4 wird, sieht es so aus, als ob die Do until c > LastCol nicht funktioniert.

Im Folgenden sind einige Screenshots, als Erklärung:

Erste Reihe, die funktioniert:

Zweite Reihe, die nicht funktioniert:

Answer 1

I FOR-Schleifen bevorzugen.

Auch gab es eine Menge Redundanz.

Sub Test2() 
Dim sht As Worksheet 
Dim Lastrow&, LastCol& 
Dim r&, c& 
Dim RangeName as String 

Set sht = Worksheets("Calculations") 
Lastrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row + 1 
LastCol = (Lastrow - 2) * 3 'need to be careful with this, too many rows will go off the page in columns. 


For r = 3 To Lastrow 
    RangeName = "Airline_" & r - 2 
    Set cell = sht.Cells(r, 5) 
    For c = 8 To LastCol Step 3 
     Set cell = Union(cell, sht.Cells(r, c)) 
    Next c 
    sht.Names.Add Name:=RangeName, RefersTo:=cell 
Next r 

End Sub