Find And Replace Next Highest

Sub FindME()
Dim I, B
B = 2
For I = 8 To 1000 Step 8
On Error GoTo 10
Cells.Find(What:=I, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
ActiveCell.Value = B
B = B + 2
10
On Error GoTo 10
Next I
End Sub

Sub FandR()
Dim FindV As Integer
Dim ReplV as Integer
Dim c As Range


On Error Resume Next
FindV = 1
ReplV = 1
With Worksheets(1).Range("A:A")
    Set c = .Find(FindV, LookIn:=xlValues)
    If Not c Is Nothing Then
        Firstaddress = c.Address
        Do
            c.Value = ReplV
            FindV = FindV + 8
            ReplV = ReplV + 2
            Set c = .Find(FindV, After:=c, LookIn:=xlValues)
        Loop While Not c Is Nothing Or c.Address <> Firstaddress
    End If
End With
End Sub