Fiill-in blank is not filling all cells

Hi AB33

Change your definition of LR to this

LR = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious).Row

from this

LR = Range("A" & Rows.Count).End(xlUp).Row

and that'll fix this issue

Why is the macto stops at line 18 and does not fill in the rest of the cellls?

I'll play with the loop to fix this issue (unless someone else posts first)

How do I incorporate a loop for all sheets and cell which have the same strcture as the attached

Hi AB33

Try this

Option Explicit
Public Sub CopyDown()
    Dim i As Long
    Dim LR As Long
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            LR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row
            For i = 1 To LR
                If .Range("A" & i).Value = "" Then
                    .Range("A" & i - 1 & ":B" & i - 1).Copy Destination:=.Range("A" & i)
                End If
            Next i
        End With
    Next ws
End Sub

Hi AB33

You're welcome...glad I could help. Thanks for the style points.