I want to transfer DATA (Item Code and Item Name) from ITEM RECEIVED SHEET by clicking SAVE Button to ITEM LIST SHEET frequently. If found same Item Code and same Item Name exist previously in this sheet then no data will be transfer from ITEM RECEIVED SHEET while item receiving in ITEM RECEIVED SHEET and again I want to transfer DATA (Item Code and Qty) from ITEM RECEIVED SHEET by clicking SAVE Button to SUPPLIER LIST SHEET frequently after every invoice entry complete.
NB: Above mentioned in ITEM RECEIVED SHEET there is only used 4 no’s of column for Item Name. what will be the code if found more than four item in any INVOICE.
I have code as below for this. But it is not working properly, and confirm that there is must be fatal mistake in the coding which I have used.
Code: Select all
Sub Save_Data()
Dim ws As Worksheet
Dim wt As Worksheet
Dim wt As Worksheet
Dim s As Long
Dim t As Long
Dim r As Long
Application.ScreenUpdating = False
Set ws = Worksheets("ITEM RECEIVED")
Set wt = Worksheets("SUPPLIER LIST")
Set wt = Worksheets("ITEM LIST")
' Find first empty row in columns A:M on SUPPLIER LIST Sheet
t = wt.Range("A:L").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
' Copy Item Name and Quantity
For s = 1 To 4
wt.Cells(t, 2 * s + 2).Value = ws.Range("E" & s + 2).Value
wt.Cells(t, 2 * s + 3).Value = ws.Range("F" & s + 2).Value
wt.Range("M" & t).Value = ws.Range("X3").Value
Next s
'Copy Date
wt.Range("B" & t).Value = ws.Range("A3").Value
'Copy Invoice No
wt.Range("C" & t).Value = ws.Range("B3").Value
'Copy Company Name
wt.Range("D" & t).Value = ws.Range("C3").Value
' Find first empty row in columns A:D on ITEM LIST Sheet
t = wt.Range("B:C").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
' Copy Item Code and Item Name
For s = 1 To 4
wt.Cells(t, 2 * s + 2).Value = ws.Range("D" & s + 2).Value
wt.Cells(t, 2 * s + 3).Value = ws.Range("E" & s + 2).Value
Next s
Application.ScreenUpdating = True
End Sub
Yours sincerely
tarun@1964