Macro to rename cell content based on the starting character until found same character

1 mistake in previus, this should be the good one

Sub Leo()
Dim st As Range, en As Range, lr As Long
lr = Range("A" & Rows.Count).End(xlUp).Row - 1
r = 1
With Sheets("sheet1")
    Set st = .Cells.Find(what:="From Store:", after:=Range("A" & r), LookIn:=xlValues, LookAt:= _
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False)
    Range("A" & st.Row, "E" & st.Row).Delete shift:=xlUp
    Set st = .Cells.Find(what:="Total from:", after:=Range("A" & r), LookIn:=xlValues, LookAt:= _
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False)
    Range("A" & st.Row, "E" & st.Row).Delete shift:=xlUp
    For x = 1 To lr
        Set st = .Cells.Find(what:="To Store:", after:=.Range("A" & r), LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False)
        Set en = .Cells.Find(what:="Total to:", after:=.Range("A" & r), LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False)
        .Range("B" & st.Row, "B" & en.Row).Value = .Range("B" & st.Row)
        r = en.Row
    Next
End With
End Sub

Kind regards

Dear Leo,

Thx it worked.