VBA move row data to their related sheet but if duplicate row found then skip that row - vba

Question

I have a sheet named "RAW ITEMS" with data, and also have few more sheets with different name, where i need to move data from "RAW ITEMS" sheet. and all sheet name are available at sheet "RAW ITEMS" in Column C3 to C100.
When I run below code It's works good when I run it first time.
But when I add some data to Sheet "RAW ITEMS", It's also move earlier Rows to their related sheet. I can't figure out how to stop moving duplicate rows.
I mean how to skip if duplicate raw found in those sheets where data are moving?
Sub copyPasteData()
Dim PV As String
Dim ps As String
Dim LastRow As Long
PV = "RAW ITEMS"
Sheets(PV).Visible = True
Sheets(PV).Select
Range("C3").Select
Do While ActiveCell.Value <> ""
ps = ActiveCell.Value
ActiveCell.Offset(0, -2).Resize(1, ActiveCell.CurrentRegion.Columns.Count).Select
Selection.Copy
Sheets(ps).Visible = True
Sheets(ps).Select
LastRow = pvs("A")
Cells(LastRow + 1, 1).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets(PV).Select
ActiveCell.Offset(0, 2).Select
ActiveCell.Offset(1, 0).Select
Loop
Range("A1").Select
End Sub
Public Function pvs(col)
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
pvs = LastRow
End Function
I am newbies in VBA. Please help me.
how to skip if duplicate raw found in those sheets where data are moving?
This is the file link for better understand

Answer 1

Try the next code, please. It avoids any selection, activation which consumes Excel resources, without bringing any benefit. It should be fast, using arrays and working in memory:
Sub copyPasteData()
Dim PVWs As Worksheet, PSWs As Worksheet, arrPV, arrPS, arPV, arPS
Dim LastRPv As Long, LastRPs As Long, lastCol As Long, i As Long
Dim j As Long, boolCopy As Boolean
Set PVWs = Worksheets("RAW ITEMS")
LastRPv = PVWs.Range("C" & Rows.Count).End(xlUp).Row
lastCol = PVWs.UsedRange.Columns.Count
'load the range in an array:
arrPV = PVWs.Range(PVWs.Range("A" & 2), PVWs.Cells(LastRPv, lastCol)).Value
For i = 1 To UBound(arrPV) 'iterate between the array rows
On Error Resume Next
Set PSWs = Worksheets(CStr(arrPV(i, 3))) 'set the sheet to paste, if no a similar row exists
If Err.Number = 9 Then
Err.Clear: On Error GoTo 0
Dim ans As VbMsgBoxResult
ans = MsgBox("The sheet " & CStr(arrPV(i, 3)) & " does not exist!" & vbCrLf & _
"Would you like to create it?", vbYesNo, "Sheet creation confirmation")
If ans <> vbYes Then GoTo OverIt
Set PSWs = Worksheets.Add(after:=Worksheets(Worksheets.Count)) 'add the new sheet (after the last)
PSWs.Name = arrPV(i, 3) 'name the newly inserted sheet
'copy the header from the previous sheet:
PSWs.Previous.Range("A1:G1").Copy Destination:=PSWs.Range("A1")
End If
On Error GoTo 0
arPV = Application.Index(arrPV, i, 0) 'a slice of the i row (1D array)
LastRPs = PSWs.Range("A" & Rows.Count).End(xlUp).Row 'last row
'load the sheet existing range in an array
arrPS = PSWs.Range(PSWs.Range("A" & 1), PSWs.Cells(LastRPs, lastCol)).Value
For j = 1 To UBound(arrPS) ' iterate and check if the sliced rows are all the elements identic
boolCopy = True
arPS = Application.Index(arrPS, j, 0) 'a slice of the j row (1D array)
If Join(arPV, "|") = Join(arPS, "|") Then 'check if the rows are the same
boolCopy = False: Exit For
End If
Next j
If boolCopy Then
'if not alsready in the sheet, the array is copied
PSWs.Range("A" & LastRPs + 1).Resize(1, UBound(arPV)).Value = arPV
boolCopy = False 'reinitialize the Boolean variable
End If
OverIt:
Next i
End Sub
The code logic assumes that "duplicate row" means that all the cells values on a sheet to copy row are identic whit the one of the analyzed row to be copied.
And in the C column the sheet itself name should exist...