copy information invoice from sheet to another sheet

[Mussa]

hi guys
I want transfer data from sheet invoice to sheet data .it should copy cells (B5,D5,I5) to columns A,B,C,D with considering repeat them to finsh last row and from row9 sholud copy from column A:I to sheet data from column D :L

invoice.xlsm
	A	B	C	D	E	F	G	H	I
5	invoice no	4902	client :	as1				date:	16/11/2021
6									Requested From
7		4902_
8	item	code	brand	unit	unit price	qty	total	package	package count
9	1	cca1	tt1	mm	10	120	1,200.00	box	2.00
10	2	cca2	tt2	mm	10	10	100.00	box	3.00
11	3	cca3	tt3	mm	11	10	110.00	box	4.00
12	4	cca4	tt4	mm	12	11	132.00	box	5.00
13
14
15
16
17
18
19
20
21
22
23
24
25							1,542.00	total
26	record		tax				-		discount
27	168 - 267 - 215		14/191/2259/5				215.88		tax
28	n/m						1,757.88	net
29			mm
invoice

Cell Formulas
Range	Formula
I5	I5	=TODAY()
B7	B7	=B5&"_"&B6
C13:C24	C13	=IFERROR(VLOOKUP(K13,الأسعار!$F:$G,2,0),"")
D13:D24	D13	=IFERROR(VLOOKUP(C13,الأسعار!$A:$C,3,0),"")
E13:E24	E13	=IFERROR(VLOOKUP(K13,الأسعار!$F:$H,3,0),"")
A13:A24	A13	=IF(C13="","",A12+1)
G9:G24	G9	=IFERROR(E9*F9,"")
G25	G25	=SUM(G9:G24)
G26	G26	=G25*-H26
G27	G27	=(G25-G26)*14%
G28	G28	=G25-G26+G27

Named Ranges
Name	Refers To	Cells
الأسعار!_FilterDatabase	=الأسعار!$B$1:$B$253	D13:D24

EXPECTED RESULT

invoice.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	invoice no	client :	date:	ITEM	code	brand	unit	unit price	qty	total	package	package count
2	4902	as1	16/11/2021	1	cca1	tt1	mm	10	120	1,200.00	box	2.00
3	4902	as1	16/11/2021	2	cca2	tt2	mm	10	10	100.00	box	3.00
4	4902	as1	16/11/2021	3	cca3	tt3	mm	11	10	110.00	box	4.00
5	4902	as1	16/11/2021	4	cca4	tt4	mm	12	11	132.00	box	5.00
6
7
8
9
10
11
12
13
Data

Cell Formulas
Range	Formula
C2:C5	C2	=TODAY()
J2:J5	J2	=IFERROR(H2*I2,"")

I try without using loop , but it doesn't succeed . any help ,please?

Sub copyinvoices()
Dim sh1, sh2 As Worksheet, lr1, lr2, r As Long
Set sh1 = Sheet1
Set sh2 = Sheet5
lr1 = sh1.Range("a" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("a" & Rows.Count).End(xlUp).Row + 1

sh2.Range("a2:a" & lr2).Value = sh1.Range("b5").Value
sh2.Range("b2:b" & lr2).Value = sh1.Range("i5").Value
sh2.Range("c2:c" & lr2).Value = sh1.Range("d5").Value
sh2.Range("d2:d" & lr2).Value = sh1.Range("d2:d" & lr1).Value
sh2.Range("e2:e" & lr2).Value = sh1.Range("e2:e" & lr1).Value
sh2.Range("f2:f" & lr2).Value = sh1.Range("f2:f" & lr1).Value
sh2.Range("g2:g" & lr2).Value = sh1.Range("g2:g" & lr1).Value
sh2.Range("h2:h" & lr2).Value = sh1.Range("h2:h" & lr1).Value
sh2.Range("i2:i" & lr2).Value = sh1.Range("i2:i" & lr1).Value
sh2.Range("j2:j" & lr2).Value = sh1.Range("j2:j" & lr1).Value

End Sub

 

[mohadin]

Hi
Try

Sub test()
Dim a, a1
With Sheets("invoice")
a1 = Array(.Range("B5"), .Range("D5"), .Range("I5"))
a = .Range(.Range("B9"), .Range("B9").End(xlDown)).Offset(, -1).Resize(, 9)
With Sheets("Data")
.Range("A2").Resize(UBound(a), 3) = a1
.Range("D2").Resize(UBound(a), UBound(a, 2)) = a
.Range("D2").Resize(UBound(a), UBound(a, 2)).Select
.Columns(3).NumberFormat = "dd/mm/yyyy"
End With: End With
End Sub

 

[Mussa]

that's great ! just curiosity instead of repeat (B5,D5,I5) can I merge like this

invoice.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	invoice no	client :	date:	ITEM	code	brand	unit	unit price	qty	total	package	package count
2	4902	as1	16/11/2021	1	cca1	tt1	mm	10	120	1,200.00	box	2.00
3				2	cca2	tt2	mm	10	10	100.00	box	3.00
4				3	cca3	tt3	mm	11	10	110.00	box	4.00
5				4	cca4	tt4	mm	12	11	132.00	box	5.00
Data

 

[mohadin]

Sub test()
Dim a, a1
With Sheets("invoice")
a1 = Array(.Range("B5"), .Range("D5"), .Range("I5"))
a = .Range(.Range("B9"), .Range("B9").End(xlDown)).Offset(, -1).Resize(, 9)
With Sheets("Data")
.Range("A2").Resize(UBound(a)).MergeCells = True
.Range("B2").Resize(UBound(a)).MergeCells = True
.Range("C2").Resize(UBound(a)).MergeCells = True
With Union(.Range("A2").Resize(UBound(a)), .Range("B2").Resize(UBound(a)), .Range("C2").Resize(UBound(a)))
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
 End With
.Range("A2").Resize(, 3) = a1
.Range("D2").Resize(UBound(a), UBound(a, 2)) = a
.Range("D2").Resize(UBound(a), UBound(a, 2)).Select
.Columns(3).NumberFormat = "dd/mm/yyyy"
End With: End With
End Sub

 

[Mussa]

thanks , but it gives " Method Of Range Class Failed error" in this line

.Range("D2").Resize(UBound(a), UBound(a, 2)).Select

also I've found the code replace the data every time run the macro . it should copy to the bottom when run the macro repeatedly .

​

​

 

[mohadin]

Well

Sub test()
Dim a, a1
With Sheets("invoice")
a1 = Array(.Range("B5"), .Range("D5"), .Range("I5"))
a = .Range(.Range("B9"), .Range("B9").End(xlDown)).Offset(, -1).Resize(, 9)
With Sheets("Data")
lr = .Cells(Rows.Count, 4).End(xlUp).Row + 1
.Range("A" & lr).Resize(UBound(a)).MergeCells = True
.Range("B" & lr).Resize(UBound(a)).MergeCells = True
.Range("C" & lr).Resize(UBound(a)).MergeCells = True
With Union(.Range("A" & lr).Resize(UBound(a)), .Range("B" & lr).Resize(UBound(a)), .Range("C" & lr).Resize(UBound(a)))
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
 End With
.Range("A" & lr).Resize(, 3) = a1
.Range("D" & lr).Resize(UBound(a), UBound(a, 2)) = a
.Columns(3).NumberFormat = "dd/mm/yyyy"
End With: End With
End Sub

 

[Mussa]

many thanks master
have a good day !

 

[mohadin]

You are very welcome Mussa
Thank you for the feedback
Be happy & safe