Help In Existing Code In Resize

[Haree]

Hi all, I am attaching my current Code. It works perfectly fine. But due to certain changes I have to modify the code to copy 4 columns instead of 5 . When I change that part, The paste section is looping fully.

Sub Copy_Rows()
Application.ScreenUpdating = False
Dim R As Range, Cell As Range
Set R = Range("H2:H500")
For Each Cell In R
If Cell.Value = "Error" Then
MsgBox "Kindly Check Errors and try again"
Exit Sub
End If
Next Cell
Dim Drange As Range
Dim psheet As Worksheet
Set Drange = Range("A2:E500")
For Each psheet In Worksheets
psheet.Unprotect Password:="STOCK"
Next psheet
Sheets("Data Sheet").Activate
Dim i As Long
Dim Lastrow As Long
Lastrow = Sheets("Data Sheet").Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
For i = 2 To Lastrow
Lastrowa = Sheets(Cells(i, 1).Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(i, 2).Resize(, 5).Copy Sheets(Cells(i, 1).Value).Rows(Lastrowa)
Next
Drange.ClearContents
For Each psheet In Worksheets
If psheet.Name <> "Data Sheet" And psheet.Name <> "Daily Extract" Then
psheet.Protect Password:="STOCK", AllowFormattingCells:=True, DrawingObjects:=False, Scenarios:=True
Else
psheet.Unprotect Password:="STOCK"
End If
Next psheet
MsgBox "Data Updated Successfully"
Application.ScreenUpdating = True
End Sub

The place where I am changing is

For i = 2 To Lastrow
Lastrowa = Sheets(Cells(i, 1).Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(i, 2).Resize(, 5).Copy Sheets(Cells(i, 1).Value).Rows(Lastrowa)
Next

I am changing the Resize Portion.
Any help would be greatly appreciated.
Many Thanks

BEFORE EDITING

Gold Stock.xlsm
	A	B	C	D
70	14-07-2022	Sales	1	4.03
71	15-07-2022	Sales	1	54.63
72	21-07-2022	Sales	1	12.14
Chains

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B72	Cell Value	contains "Sales"	text	NO
B72	Cell Value	contains "Purchase"	text	NO
B71	Cell Value	contains "Sales"	text	NO
B71	Cell Value	contains "Purchase"	text	NO
B70	Cell Value	contains "Sales"	text	NO
B70	Cell Value	contains "Purchase"	text	NO

AFTER EDITING Resize to 4

Gold Stock.xlsm
	A	B	C	D	E		G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK
89	22-07-2022	Sales	1	1	22-07-2022		1	1	#######	Sales	1	1	#######	Sales	1	1	22-07-2022	Sales	1	1	22-07-2022	Sales	1	1	#######	Sales	1	1	#######	Sales	1	1	#######	Sales	1	1	#######
Rings

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B89,F89,J89,N89,R89,V89,Z89,AD89,AH89,AL89,AP89,AT89,AX89,BB89,BF89,BJ89,BN89,BR89,BV89,BZ89,CD89,CH89,CL89,CP89,CT89,CX89,DB89,DF89,DJ89,DN89,DR89,DV89,DZ89,ED89,EH89,EL89,EP89,ET89,EX89,FB89,FF89,FJ89,FN89,FR89,FV89,FZ89,GD89,GH89,GL89,GP89,GT89,GX89,HB89	Cell Value	contains "Sales"	text	NO
B89,F89,J89,N89,R89,V89,Z89,AD89,AH89,AL89,AP89,AT89,AX89,BB89,BF89,BJ89,BN89,BR89,BV89,BZ89,CD89,CH89,CL89,CP89,CT89,CX89,DB89,DF89,DJ89,DN89,DR89,DV89,DZ89,ED89,EH89,EL89,EP89,ET89,EX89,FB89,FF89,FJ89,FN89,FR89,FV89,FZ89,GD89,GH89,GL89,GP89,GT89,GX89,HB89	Cell Value	contains "Purchase"	text	NO

 

[Fluff]

Try

Cells(i, 2).Resize(, 4).Copy Sheets(Cells(i, 1).Value).Cells(Lastrowa,1)

 

[Haree]

Hi @Fluff
Worked perfectly as always.
Many Thanks.

Just for learning can I please know why it was working fine with 5 and not with 4. I understood that the basic syntax was wrong and I was referring to the entire Row.

 

[Fluff]

I'm surprised it worked for 5 columns, so have no idea why it did.