VBA Code for not to Create/Copy Duplicate Rows

[Gajendra72]

Hi friends,

I have created a workbook of 6 sheets who's VBA code I have writted is,

Sub CopyDataBasedOnStatusCondtion()


Dim lRow, cRow As Long
lRow = Sheets("Sheet1").Range("A50000").End(xlUp).Row




For j = lRow To 1 Step -1



If Sheets("Sheet1").Range("B" & j) = "9265553826" Then
cRow = Sheets("9265553826").Range("A50000").End(xlUp).Row
Sheets("Sheet1").Rows(j).Copy Destination:=Sheets("9265553826").Range("A" & cRow + 1)


ElseIf Sheets("Sheet1").Range("B" & j) = "9978651125" Then
cRow = Sheets("9978651125").Range("A50000").End(xlUp).Row
Sheets("Sheet1").Rows(j).Copy Destination:=Sheets("9978651125").Range("A" & cRow + 1)


ElseIf Sheets("Sheet1").Range("B" & j) = "ALEO" Then
cRow = Sheets("Aleo").Range("A50000").End(xlUp).Row
Sheets("Sheet1").Rows(j).Copy Destination:=Sheets("ALEO").Range("A" & cRow + 1)


ElseIf Sheets("Sheet1").Range("B" & j) = "JASWANT" Then
cRow = Sheets("JASWANT").Range("A50000").End(xlUp).Row
Sheets("Sheet1").Rows(j).Copy Destination:=Sheets("JASWANT").Range("A" & cRow + 1)


ElseIf Sheets("Sheet1").Range("B" & j) = "ARBUDA" Then
cRow = Sheets("ARBUDA").Range("A50000").End(xlUp).Row
Sheets("Sheet1").Rows(j).Copy Destination:=Sheets("ARBUDA").Range("A" & cRow + 1)


End If
Next


End Sub

Now the issue is that whenever I click button, it creates duplicate entries/row in other 5 sheets.
Please help me to solve this issue with VBA code that it wont create duplicate entries in other sheets.

Thanks in Advance.

 

[Gajendra72]

One more issue,
If there s no data in Sherry's Column A or any other column till H, row doesn't get copied to relative sheet. I want that to happen.

Please help.