Sorry, Chipchuck, I missed the column D.
For reference, the below code is adjusted to account for that.
Sub CopyIt()
Dim cl As Range
With Worksheets("Sheet1")
For Each cl In .Range("B1:B" & .Range("B65536").End(xlUp).Row)
If cl.Value = "PROVIDER" Then
cl.offset(0,2).Copy Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next cl
End with
End Sub
FYI, this will accomplish what you want without moving the activecell. We could modify it to use the activecell, but it is unnecessary to do so. Basically what this does is look at B1 and if it equals "PROVIDER" it will copy D1 to the next available cell on Sheet2 column A. Then it goes back to B2 and continues on.
I haven't tried Aaron's (Open Source! ) solution, but am sure it will work also.