How do I fill a series using VBA?

Question

I'm trying to get my code to search column D for cells that are not blank. When it finds one that isn't blank it copies that cell and fills the series beneath. Then I want it to repeat this code until "D3020".

However each time I run my code it takes the copied cell and continuously pastes it all the way down to "D3020". There are different values that also need to be copied so I need to fix this. I have tried using the .offset property. I have tried using .range.copy property.

 Sub Fill()
 Dim SRng As Range
 Dim SCell As Range

 Set SRng = Range("D1101:D3020")

 For Each SCell In SRng
     If SCell <> "" Then
         SCell.Copy
         Range(SCell, SCell.Offset(10, 0)).PasteSpecial(xlPasteAll)
     End If
 Next SCell

 End Sub

I'd like this code to search Range("D1101:D3020") for cells that <> "". When one is found, fill the series beneath it, stopping at the next cell with a number in it.

For example

D1101 = 1601166 (see picture) I want to copy this and fill the series beneath it. All are exactly ten rows apart. Then D1121 = 1601168 (see picture) I want to copy/fill series for this as well.

Answer 1

No need for a loop; just fill the blanks with the value above.

sub fillBlanks()

    dim brng as range

    on error resume next
    set brng = Range("D1101:D3020").specialcells(xlcelltypeblanks)
    on error goto 0

    if not brng is nothing then
        brng.formular1c1 = "=r[-1]c"
        Range("D1101:D3020") = Range("D1101:D3020").value
    end if

end sub