اتفضل اخى الحبيب ضع هذا الكود فى حدث الشيت
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 2 Then
With Sheets(1)
X = Range("b" & Rows.Count).End(xlUp).Rowmaxvalue = 0
For i = 4 To X
If Range("b" & i) <> "" Then
Range("a" & i) = maxvalue + 1
maxvalue = maxvalue + 1
Else
Range("a" & i) = ""
End If
Next
End With
End If
End Sub