Option Explicit
Sub test()
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim i As Long
Dim k As Long
With Worksheets("Tabelle1")
For i = 1 To .Cells(.Rows.Count, "V").End(xlUp).Row
k = 0
Do
Set rng = Union(.Range("V" & i), _
.Range("W" & i).Offset(, k).Resize(, IIf(k > 0, 2, 3)), _
.Range("AO" & i)).Cells
Debug.Print rng.Address(False, False) & " - {i:" & i & ", k:" & k & "}"
With AreaCellByIdx(rng, 1)
Debug.Print Spc(2); .Address(False, False) & " = '" & .Text & "'"
End With
With AreaCellByIdx(rng, 2)
Debug.Print Spc(2); .Address(False, False) & " = '" & .Text & "'"
End With
k = k + 3 - Abs(k > 0)
Loop While k < 17
Next
End With
End Sub
Private Function AreaCellByIdx(Range As Excel.Range, ByVal Index As Long) As Excel.Range
Dim i As Long
For i = 1 To Range.Areas.Count
With Range.Areas(i)
If Index > .Cells.Count Then
Index = Index - .Cells.Count
Else
Set AreaCellByIdx = .Cells(Index)
Exit Function
End If
End With
Next
Err.Raise 9
End Function