DATA TRANSFERRING IN TWO EXCEL SHEET AT A TIME

[TARUNKANTI1964]

Sub SaveData()

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:J").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

' Copy Item Name and Item Quantity

For s = 1 To 4

wt.Cells(t, 2 * s + 2).Value = ws.Range("F" & s + 2).Value

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

wt.Range("M" & t).Value = ws.Range("X5").Value

Next s

'Copy Date

wt.Range("B" & t).Value = ws.Range("A5").Value

'Copy Invoice No

wt.Range("C" & t).Value = ws.Range("B5").Value

'Copy Company Name

wt.Range("D" & t).Value = ws.Range("C5").Value

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

t = wt.Range("A: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

The Above stated code I have used for a Work book for transferring Data at a time in to Sheet2 and Sheet3 simultaneously from Sheet1 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 SUPPLIER NAME and ITEM NAME is already there in Sheet2 and if the same thing is adopted in next in Sheet1 with different Invoice No then ITEM CODE and ITEM NAME will not be repeat in Sheet2, as per row wise.    

 Sheet1) ITEM RECEIVED

DATE

INV NO

SUPPLIER NAME

ITEM CODE

ITEM NAME

QTY

UNIT PRICE

ITEM CODE

ITEM NAME

QTY

UNIT PRICE

ITEM CODE

ITEM NAME

QTY

UNIT PRICE

ITEM CODE

ITEM NAME

QTY

UNIT PRICE

SUB TOTAL

TAX

VALUE INCLUDING TAX

DISC

INVOICE VALUE

Sheet2) ITEM LIST 

Sr. No

Item Code

Item Name

Sales Price

Sheet3) SUPPLIER LIST 

Sr. No

Date

Invoice No

Supplier Name

Item Name

Qty

Item Name

Qty

Item Name

Qty

Item Name

Qty

Invoice Value

Unfortunately, above stated code not work properly. Is it possible for transferring schedule data in both sheet at a time by pressing SAVE BUTTON?

May I get help? With regards

[#2]

@TARUNKANTI1964 

You have a duplicate variable declaration like this...

Dim wt As Worksheet
Dim wt As Worksheet

Also, you are setting reference of two worksheets to the same variable...

Set wt = Worksheets("SUPPLIER LIST")

Set wt = Worksheets("ITEM LIST")

So in the end wt worksheet variable will hold the reference of the Item List Sheet and the Supplier List Sheet is nowhere in the picture.

Please try this tweaked version and see if that works for you. Please tweak it further the loop part to make sure the correct data is being copied to the correct cells by tweaking the s long variable as per your need because I am not sure what you are trying to copy and where.

Sub SaveData()

Dim wsItemRecd As Worksheet
Dim wsSupplier As Worksheet
Dim wsItemList As Worksheet
Dim s As Long
Dim t As Long
Dim r As Long

Application.ScreenUpdating = False

Set wsItemRecd = Worksheets("ITEM RECEIVED")

Set wsSupplier = Worksheets("SUPPLIER LIST")

Set wsItemList = Worksheets("ITEM LIST")


' Copy Item Name and Item Quantity

For s = 1 To 4
    ' Find first empty row in columns A:J on SUPPLIER LIST Sheet
    t = wsSupplier.Range("A:J").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

    wsSupplier.Cells(t, 2 * s + 2).Value = wsItemRecd.Range("F" & s + 2).Value
    
    wsSupplier.Cells(t, 2 * s + 3).Value = wsItemRecd.Range("E" & s + 2).Value
    
    wsSupplier.Range("M" & t).Value = wsItemRecd.Range("X5").Value

Next s

'Copy Date

wsSupplier.Range("B" & t).Value = wsItemRecd.Range("A5").Value

'Copy Invoice No

wsSupplier.Range("C" & t).Value = wsItemRecd.Range("B5").Value

'Copy Company Name

wsSupplier.Range("D" & t).Value = wsItemRecd.Range("C5").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 = wsItemList.Range("A:C").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

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

Next s

Application.ScreenUpdating = True

End Sub

[#3]

Respected @Subodh_Tiwari_sktneer Sir,

Although You have tried hard for me and I did what You did, but unfortunately it is not working properly. After using Your Code results as below.But I thank You so much for helping me in this regards. 

1) ITEM RECEIVED Sheet

DATE

INVOICE NO

SUPPLIER NAME

ITEM CODE

ITEM NAME

QTY

UNIT PRICE

ITEM CODE

ITEM NAME

QTY

UNIT PRICE

ITEM CODE

ITEM NAME

QTY

UNIT PRICE

ITEM CODE

ITEM NAME

QTY

UNIT PRICE

SUB TOTAL

TAX

VALUE INCL TAX

DISC

INVOICE VALUE

18-05-2022

1

BANGUR

AB1

ABCD

1

2

AB2

EFGH

3

4

AB3

IJKL

5

6

AB4

MNOP

7

8

100

5%

105

2

103

2) ITEM LIST Sheet

Sr. No	Item Code	Item Name	Sales Price
					ITEM CODE	ITEM NAME	AB1	ABCD
					ITEM NAME	QTY	ABCD	1

3) SUPPLIER LIST

Sr. No	Date	Invoice No	Supplier Name	Item Name	Qty	Item Name	Qty	Item Name	Qty	Item Name	Qty	Invoice Value
1
2
3
4
5
6
7
8
9
10
					QTY	ITEM NAME						103
							1	ABCD				103
	18-05-2022	1	BANGUR									103