Please help! with find/copy/replace

I have tweaked a macro to do all kinds of new things thanks to searching for answers on this forum. My current issue is that it is skipping a cell. It skips the first '90601' and doesn't copy it. Thanks in advance for any help and advice!!

Dim LSearchRow As Integer
LSearchRow = 1


While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If Column D = "90601", copy entire row
If Range("D" & CStr(LSearchRow)).Value = "90601" Then
Range("D" & CStr(LSearchRow)).EntireRow.Copy
'Insert copied Row below the original
Range("D" & CStr(LSearchRow)).EntireRow.Insert Shift:=xlDown
'Change values in Columns D on new row to 20150
Range("D" & CStr(LSearchRow + 1)) = "20150"
End If

Your code misses the first value "90601" because on the same row of the missing value, column A is empty or len...= 0