DATA TRANSFER TO TWO EXCEL SHEET AT A TIME BY USING VBA

Brass Contributor

Hi Respected COMMUNITY TEAM MEMBERS, hope all of You are well. I have an Excel Workbook and I unable to access that Excel work book just as I want by using VBA Code. Actually I have a Work book for transferring Data at a time in to ITEM LIST Sheet and SUPPLIER LIST Sheet simultaneously from ITEM RECEIVED Sheet by pressing SAVE Button from which data would be transferred. And I confirm that there is must be fatal mistake in the coding which I have used. when if found ITEM CODE and ITEM NAME is already there in ITEM LIST Sheet and if the same thing is adopted again in next in ITEM RECEIVED Sheet with different Invoice No then ITEM CODE and ITEM NAME will not be repeat in ITEM LIST Sheet, as per row wise.  CODE as given below . May I get assist in this regards.

Sub SaveData()

Dim wsItemRecd As Worksheet

Dim wtSupplierList As Worksheet

Dim wtItemList As Worksheet

Dim s As Long

Dim t As Long

Dim r As Long

Application.ScreenUpdating = False

Set wsItemRecd = Worksheets("ITEM RECEIVED")

Set wtSupplierList = Worksheets("SUPPLIER LIST")

Set wtItemList = Worksheets("ITEM LIST")

' Copy Item Name and Item Quantity

For s = 1 To 4

    ' Find first empty row in columns A:M on SUPPLIER LIST Sheet

    t = wtSupplierList.Range("E:L").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

wtSupplierList.Cells(t, 2 * s + 2).Value = wsItemRecd.Range("E" & s + 2).Value

    wtSupplierList.Cells(t, 2 * s + 3).Value = wsItemRecd.Range("F" & s + 2).Value

     wtSupplierList.Range("M" & t).Value = wsItemRecd.Range("X3").Value

Next s

'Copy Date

wtSupplierList.Range("B" & t).Value = wsItemRecd.Range("A3").Value

'Copy Invoice No

wtSupplierList.Range("C" & t).Value = wsItemRecd.Range("B3").Value

'Copy Company Name

wtSupplierList.Range("D" & t).Value = wsItemRecd.Range("C3").Value

' Copy Item Code and Item Name

For s = 1 To 4

    ' Find first empty row in columns A:C on ITEM LIST Sheet

    t = wtItemList.Range("A:C").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

 wtItemList.Cells(t, 2 * s + 2).Value = wsItemRecd.Range("D" & s + 2).Value

     wtItemList.Cells(t, 2 * s + 3).Value = wsItemRecd.Range("E" & s + 2).Value

Next s

Application.ScreenUpdating = True

 

End Sub

Sheets Picture as given below which I want

 

ITEM RECEIVED Sheet

                   
 

 

SAVE
Button   
DATEINVOICE NOSUPPLIER NAMEITEM CODEITEM NAMEQTYUNIT PRICEITEM CODEITEM NAMEQTYUNIT PRICEITEM CODEITEM NAMEQTYUNIT PRICEITEM CODEITEM NAMEQTYUNIT PRICESUB TOTALTAXVALUE INCL TAXDISCINVOICE VALUE
21-05-20221BANGURAB1ABCD12AB2EFGH34AB3IJKL56AB4MNOP781005%1052103

 

ITEM LIST Sheet

Sr. NoItem CodeItem NameSales Price   
 AB1ABCD    
 AB2EFGH    
 AB3IJKL    
 AB4MNOP    
       
       
       
 ACTUALLY I WANT TO RECEIVE THE ABOVE DATA BY TRANSFERRING FROM "ITEM RECEIVED" Sheet AFTER COMPLETING ITEM RECEIVE FOR EACH TIME, BUT IF FOUND SAME ITEM RECEIVED IN SEVERAL TIME IN "ITEM RECEIVED" Sheet,THEN IT SHOULD NOT BE REPEATED
 
 
 
 
 

 

SUPPLIER LIST Sheet

Sr. NoDateInvoice NoSupplier NameItem NameQtyItem NameQtyItem NameQtyItem NameQtyInvoice Value
 21-05-20221BANGURABCD1EFGH3IJKL5MNOP7103
             
             
  ACTUALLY I WANT TO RECEIVE THE ABOVE DATA BY TRANSFERRING FROM "ITEM RECEIVED" Sheet AFTER COMPLETING ITEM RECEIVE FOR EACH TIME.   
     
     
     

With best regards

0 Replies