Copy or Move rows starting with a particular cell value until next blank row

Hi this was solved in StackOverflow:

Sub CopyDepth()
    Dim ws As Worksheet
    Dim rng As Range
    Set ws = Worksheets("Profile")
    Set rng = ws.UsedRange.Find(What:="Depth (m)")
    Range(rng, rng.End(xlToRight).End(xlDown)).Copy
    Worksheets("data").Range("A1").PasteSpecial
End Sub