S
stacia
This works for the first cell that has title "Shop Report", but it will not
continue to the next and to the end
Sub b10shop()
Dim MyRange As Range
Dim MyCell As Range
Dim EndRow As Integer
EndRow = Range("E65536").End(xlUp).Row
Set MyRange = Range("E1:E" & EndRow)
MyRange.Select
On Error Resume Next
For Each MyCell In MyRange
If MyCell.value = "Shop" Then
Cells.Find(What:="Shop Report", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("E4").Select
ActiveCell.FormulaR1C1 = "=R[3]C[-4]"
End If
Next MyCell
End Sub
continue to the next and to the end
Sub b10shop()
Dim MyRange As Range
Dim MyCell As Range
Dim EndRow As Integer
EndRow = Range("E65536").End(xlUp).Row
Set MyRange = Range("E1:E" & EndRow)
MyRange.Select
On Error Resume Next
For Each MyCell In MyRange
If MyCell.value = "Shop" Then
Cells.Find(What:="Shop Report", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("E4").Select
ActiveCell.FormulaR1C1 = "=R[3]C[-4]"
End If
Next MyCell
End Sub