Help with code to copy value if criteria is met

[joyrichter]

Good day

Thank you for your help with the above code, I am trying to tweek the code bit so that the value on the closing stock under column I is also copied to the recon sheet when the code is run, but for some reason the first 5 lines do not copy over to the recon sheet.

I tweeked the code as follows:
Sub CopyRow()
Application.ScreenUpdating = False
Dim srcWS As Worksheet, desWS As Worksheet, ws1 As Worksheet, ws2 As Worksheet
Dim v1 As Variant, v2 As Variant, v3 As Variant, dic As Object, i As Long, ii As Long
Set srcWS = Sheets("NonMovingStock")
Set desWS = Sheets("Recon")
Set ws1 = Sheets("ClosingStock") 'delete trailing space
Set ws2 = Sheets("GRN") 'delete trailing space
v1 = srcWS.Range("A5", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
v2 = ws1.Range("C2", ws1.Range("C" & Rows.Count).End(xlUp)).Value
v3 = ws2.Range("I1", ws2.Range("I" & Rows.Count).End(xlUp)).Value
Set dic = CreateObject("Scripting.Dictionary")
For i = LBound(v1) To UBound(v1)
If Not dic.exists(v1(i, 1)) Then
dic.Add v1(i, 1), i + 4
End If
Next i
For i = LBound(v2) To UBound(v2)
If dic.exists(v2(i, 1)) Then
For ii = LBound(v3) To UBound(v3)
If dic.exists(v2(i, 1)) Then
desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 7).Value = ws1.Range("C" & dic(v2(i, 1))).Resize(, 7).Value
Exit For
End If
Next ii
End If
Next i
Application.ScreenUpdating = True
End Sub



Can you please help me with this issue.

Thank you

 

[Fluff]

Duplicate to: Code to copy over row if certain criteria is met

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.