Sorry, should have read your question properly!

Try this

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
If Target = "Passed" Then
Sh.Cells(Target.Row, 5) = Sh.Cells(1, Target.Column)
End If
End If
End Sub

It needs to go on the ThisWorkbook tab


--
mrice

Research Scientist with many years of spreadsheet development experience
------------------------------------------------------------------------
mrice's Profile: http://www.excelforum.com/member.php...o&userid=10931
View this thread: http://www.excelforum.com/showthread...hreadid=561829