Como puedo hacer que esto se cumpla cada fila y cada tre so cuatro celdas hacia abajo

Private Sub AGREGAR_Click()
ActiveSheet.Cells(2, 1).Select
Selection.EntireRow.Insert
ActiveSheet.Cells(2, 1) = IdTienda.Text
ActiveSheet.Cells(2, 10) = Semana.Text
ActiveSheet.Cells(2, 4) = NombreDemo.Text
ActiveSheet.Cells(2, 18) = Producto1.Text
ActiveSheet.Cells(3, 18) = Producto2.Text
ActiveSheet.Cells(4, 18) = Producto3.Text
ActiveSheet.Cells(2, 11) = Periodo.Text

If Viernes = True Then
ActiveSheet.Cells(2, 5) = 1
Else
ActiveSheet.Cells(2, 5) = 0
End If
If SABADO = True Then
ActiveSheet.Cells(2, 6) = 1
Else
ActiveSheet.Cells(2, 6) = 0
End If
If Domingo = True Then
ActiveSheet.Cells(2, 7) = 1
Else
ActiveSheet.Cells(2, 7) = 0
End If
If Lunes = True Then
ActiveSheet.Cells(2, 8) = 1
Else
ActiveSheet.Cells(2, 8) = 0
End If
If Martes = True Then
ActiveSheet.Cells(2, 9) = 1
Else
ActiveSheet.Cells(2, 9) = 0
End If
End Sub