Make a loop in created macro

[keis386]

Hi,

I created a macro but I do not know how I can make a loop in the function?
Hope someone can help me. I also attached my excel file


Sub YEPP()

If Not IsEmpty(Range("B2")) Then

Range("B2:B8").Select
Selection.Copy
Range("B3").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

Range("B2").Select
Selection.ClearContents

Range("B2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("B2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("H2:H8", "I2:I8").Select
Selection.Copy
Range("H3", "I3").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

Range("H2", "I2").Select
Selection.ClearContents

End If
End Sub

Function of the macro is that if there is a value in B2 then B2:B8 is copied to B3:B9, also value of day of today is inserted in B2
value in B2 has to be deleted, H2:I8 copied to H3:I9, and values in H2:I2 are deleted.
Next do the same thing in cell B10 look if there is a value in B10, ….
Next do the same thing in cell B18…
etc…