How to enter a value in a single cell in a range and continue through each cell in the range

Question

I have a range A6:A24 that is blank. I want to paste the value 1 into each cell and copy a resulting calculation in H9 to a new sheet. After that I want to move to the next cell paste "1" but delete the previous "1" and paste the resulting value.

I am either able to paste 1 into every box or just the top.

A6:A24 are years. I am trying to pull the calculation for when each year is equal to 1 (100 percent) meaning all other years need to be equal to zero.

Private Sub CommandButton1_Click()

Dim inputRange1 As Range
Dim inputRange2 As Range
Dim c As Range
Dim i As Long
Dim b As Range
Dim j As Long

Set dvCell2 = Worksheets("Sheet1").Range("A6:A24")

Set inputRange2 = Worksheets("Sheet1").Range("D1")

Set dvCell1 = Worksheets("Sheet2").Range("C1")

Set inputRange1 = Worksheets("Sheet1").Range("B6:B24")

i = 1
j = 1

Application.ScreenUpdating = False
For Each b In inputRange2
    dvCell2.Value = b.Value
    For Each c In inputRange1
        dvCell1.Value = c.Value
        Worksheets("Sheet4").Cells(i + 2, j + 3).Value = Worksheets("Sheet3").Range("H9").Value
        i = i + 1
    Next c
    j = j + 1   
    i = 1
Next b
Application.ScreenUpdating = True

End Sub

Answer 1

Not sure I follow. This will loop through each cell in dvcell2 and put a 1 in it and then copy the value of H9. I'm not sure if you're attempting to do something else.

Private Sub CommandButton1_Click()

Dim inputRange1 As Range
Dim inputRange2 As Range
Dim c As Range
Dim i As Long
Dim b As Range
Dim j As Long

Set dvcell2 = Worksheets("Sheet1").Range("A6:A24")
Set inputRange2 = Worksheets("Sheet1").Range("D1")
Set dvCell1 = Worksheets("Sheet2").Range("C1")
Set inputRange1 = Worksheets("Sheet1").Range("B6:B24")

i = 1
j = 1

Application.ScreenUpdating = False

For Each b In dvcell2
    dvcell2.value=0
    b.Value = 1
    Worksheets("Sheet4").Cells(i + 2, j + 3).Value = Worksheets("Sheet3").Range("H9").Value
    j = j + 1
Next b

Application.ScreenUpdating = True

End Sub