Sales report to add header lines

I have daily sales report with a different number of lines each time.
For each invoice I need to add a header line with Sold-To, Ship-To and Invoice as repeated in the lines below (i.e. rows 2, 4, 6, 9 in the picture). Until that point my code works quite okay, however don't know how to stop the copy/ paste after the last item line in the invoice? Here it is row 21 but each day it might be different. I tried stopping it with row 100, but it goes on until few thousands.

My code so far:

Sub F_SPR_kopiujsoldto()
Application.Goto Workbooks("doc_flow_report.xlsx").Sheets("Sheet1").Range("a2")
Application.ScreenUpdating = False
Dim lr As Long
With ActiveSheet
  lr = .Columns("d").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  On Error Resume Next
  With .Range("d2:d100" & lr)
    .SpecialCells(xlCellTypeBlanks).Formula = "=R[1]C"
    .Value = .Value
  End With
  On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub

Thanks