Option Explicit Sub test() Dim i i = 2 Do Until Range("A" & i) = "" Range("A" & i).Offset(0, 3) = Range("A" & i) + 1 Range("B" & i).Offset(0, 1) = Range("B" & i) + 1 i = i + 1 Loop End Sub