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.
The place where I am changing is
I am changing the Resize Portion.
Any help would be greatly appreciated.
Many Thanks
BEFORE EDITING
AFTER EDITING Resize to 4
VBA Code:
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
Code:
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 |