Code for copying data between WS’s

[John117]

I have 2 WS’s with ~200 rows of data each. WS1 is my report and WS2 is just raw data. I do not want to use V lookup; I am in need of code:
1. Look at part # in cell A4 in WS1
2. Than find that number in column A in WS2.
3. If the number is found than copy data from WS2 (let’s say) P7 to WS1 D4 and from WS2 AB7 to WS1 K4
4. Repeat the same function for all populated cells in column A in WS1.
5. If number from column A in WS1 is not found in WS2 than fill cell A in WS1 yellow.

Hopefully this makes sense. Any help would be greatly appreciated.

Thank you
John

 

[John117]

Hello Everyone
Here is my logic how I would like to have this accomplish. Of course this is just my idea and not working code. I really cannot think of how to search for matching part # in Range("A7:A500") in Sheet “Export”, then copy same cells from the found row in Sheet "Export" into Sheet ”Parts”.
Any help would be great since I am stock.


Sub AQIS_Data ()

Dim Cell as Range
Dim I as Integer

I = 4 'I need to loop thru all rows of data in Sheet ”Parts” in Col A


For Each Cell in Sheets("Parts"). Range("A”&I:A200”)
If Cell.value is found in Sheets("Export"). Range("A7:A500") Then
Sheets("Export").Range("R”&J).Copy ‘ J – is the row # when the value was found
Sheets("Parts").Range("V”&I).PasteSpecial Paste:=xlPasteValues
Sheets("Export").Range("AC”&J).Copy
Sheets("Parts").Range("K”&I).PasteSpecial Paste:=xlPasteValues

Else
Sheets("Parts").Range("A”&I).Interior.Color = 65535

I = I + 1 'Adds 1 to I, so goes to next cell down in Col A
End If
Next

End Sub

 

[NeonRedSharpie]

Sub copyData()

    Dim report As Worksheet
    Dim extract As Worksheet
    
    Set report = Sheets("Parts")  'CHANGE IF NEEDED
    Set dataF = Sheets("Export") 'CHANGE IF NEEDED
    
    Dim startRowR As Integer
    Dim endRowR As Long
    
    Dim startRowD As Integer
    Dim endRowD As Long
    
    startRowR = 4
    endRowR = report.Cells(Rows.Count, "A").End(xlUp).Row
    
    startRowD = 1
    endRowD = dataF.Cells(Rows.Count, "A").End(xlUp).Row
    
    For x = startRowR To endRowR Step 1
        found = False
        For y = startRowD To endRowD Step 1
        
            If report.Cells(x, 1) = dataF.Cells(y, 1) Then
                report.Cells(x, 4).Value = dataF.Cells(y, 16).Value
                report.Cells(x, 11).Value = dataF.Cells(y, 28).Value
                GoTo foundcell
            End If


        Next y
report.Cells(x, 1).Interior.Color = vbYellow
foundcell:
    Next x
    


End Sub

 

[John117]

Thank you very much
Works great, but how can I modify it so this code will not copy anything past row 200 in Sheet "Parts".

 

[NeonRedSharpie]

[COLOR=#333333]    startRowR = 4
[/COLOR][COLOR=#333333]    endRowR = 200[/COLOR]