Move value in Row worksheet 1 into matched column and row in Worksheet 2

[GrantG3SA]

Hello, I have one final hurdle to complete in my excel solution which is to read rows from worksheet 1 (unlimited number of rows), and based on a name field and item field in that row, take the qty field and match it to the relevant column/row in worksheet 2. To give an understanding of need, worksheet 1 is a download of orders from an APP which i need to plug into a matrix in worksheet 2 as that drives the rest of my solution for packing and loading worksheets all in the same workbook. My final worksheets in this same workbook take a combination of Worksheet 1 and Worksheet 2 to generate an upload template which I use to create my sales orders in my accounting software.

Example below of worksheet 1 called W2O which has a number of columns that differ each day as i receive orders from the APP.

Example of Worksheet 2 called Orders which has more names going across in columns than my W2O sheet above as well as more Items in rows than my W2O sheet above.

I need to take the QTY from W2O and match to the relevant column using Name, then find the relevant row match using Item and insert the Qty. Looping through the full W2O to create my matrix.

My attempt can match Name to get the Column and Item to get the Row but I am lost positioning to the correct cell.
Sub SAVE()

Dim Fnd As Range
With Sheets("W2O")
Set Fnd = Sheets("Orders").Range("A1:K1").Find(.Range("D2").Value, , , xlWhole, , , False, , False)
If Not Fnd Is Nothing Then
'Mach to Row...?
Set Fnd = Sheets("Orders").Range("A2:A18").Find(.Range("G2").Value, , , xlWhole, , , False, , False)
' Fnd.Offset [(,2)].Value = .Range("I2").Value <-this line has a syntax error but is wrong anyway with an offset hardcoded.
End If
End With

End Sub

 

[mumps]

Try:

Sub GrantG3SA()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, rName As Range, fnd As Range, item As Range
    Set srcWS = Sheets("W2O")
    Set desWS = Sheets("Orders")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rName In srcWS.Range("D2:D" & LastRow)
        Set fnd = desWS.Rows(1).Find(rName, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            Set item = desWS.Range("A:A").Find(rName.Offset(, 3).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not item Is Nothing Then
                desWS.Cells(item.Row, fnd.Column) = rName.Offset(, 5)
            End If
        End If
    Next rName
    Application.ScreenUpdating = True
End Sub

 

[GrantG3SA]

Hi Mumps,
Thank you. works perfectly.
regards
Grant

 

[mumps]

You are very welcome.