Copy Paste multiple non adjacent cells to different work sheet based on EventHandler

[ARL]

Having trouble writing the code to copy paste multiple cells in a column to a different worksheet based on an EventHandler.

I have a sheet (Manage All Orders) that I want to extract information out of, but only need specific cells from that column of cells and only if I trigger one of the cells from that column.

ie: I want to copy cell H, N, O, AC, Y from Row 5 and paste to another sheet (List) in B, C, D, E, F Row 2 only if I trigger cell AC5 by entering a number. Each time I trigger cell AC?? on a row it would be added to sheet (List) on the next row.

This would apply for the above mentioned cells rows 9 thru to 200, again only if cells AC9 thru to AC200 has a number entered into it.

My code for the EventHandler is as follows:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rangeToChange As Range

Set rangeToChange = Range("AC9:A200")

'Run the code when a cell within a range is changed.
If Not Intersect(Target, rangeToChange) Is Nothing Then

'Run a macro that is located inside a Module
Call Another_Macro

End If

End Sub

The copy and paste code would be located in a Module

I have attached the excel worksheet

01-PU Template-Test.xltm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC
1
2																			****If a number is placed in the Trigger cell, then H, N, O, AC and Y of that row are placed on the "List"
3								FOR ILLASTRATION PURPOSES ONLY showing which cells are copied to the "List"											Should not matter what Row is triggered, it should be place on the next available Line on the "List"
4								The rows change daily
5																			**Would be handy if the Date Field had a pop up Calander										TRIGGER
6		Vet
7		Order	X			Submitted	Product	CO	Submitted By	PickUp	Pros	Wght	Unit	First	Last	First Last	Prod	Pend	Eng	Text	Print	Instructions	PickUp	Status	Date	Time	By	Pos	ID Tag
8		Bus A
9		928041622	X			9/8/2020	G	Bus A	WS	PICKUP	9/8/2020	1.60	kg	FirstA	LastA	FirstA LastA	B	N/A	B		N/A			New Order
10		905262048	X			9/19/2020	G	Bus A	WS	PICKUP	9/19/2020	10.00	kg	FirstB	LastB	FirstB LastB	B	N/A	B		N/A			New Order
11		905603633	X			9/19/2020	G	Bus A	WS	PICKUP	9/19/2020	9.00	kg	FirstC	LastC	FirstC LastC	B	N/A	B		N/A			New Order
12		995559283	X			9/19/2020	P	Bus A	WS	PICKUP	9/19/2020	3.50	kg	FirstD	LastD	FirstD LastD	S	N/A	N/A		N/A			New Order	09-20-2020				10001
13		Bus B
14		950459251	X			5/12/2020	G	Bus B	JA	HOLD	5/12/2020	5.90	kg	FirstE	LastE	FirstE LastE	B	N/A	B		N/A			New Order
15		984343141	X			9/20/2020	G	Bus B	JA	PICKUP	9/20/2020	2.60	kg	FirstF	LastF	FirstF LastF	B	N/A	B		N/A			New Order
16		Bus C
17		976804658	X			9/19/2020	P	Bus C	TP	PICKUP	9/19/2020	2.29	kg	FirstG	LastG	FirstG LastG	S	N/A	N/A		N/A			New Order	09-21-2020				10008
18		Bus D
19		977842513	X			8/29/2020	P	Bus D	JB	HOLD	8/29/2020	6.00	lb	FirstH	LastH	FirstH LastH	S	N/A	N/A		N/A			New Order
20		969609313	X			9/9/2020	P	Bus D	JB	PICKUP	9/9/2020	7.80	lb	FirstI	LastI	FirstI LastI	S	N/A	BR	MC	N/A			New Order
21		Bus E
22		908999595	X			9/19/2020	P	Bus E	JN	PICKUP	9/19/2020	25.00	lb	FirstJ	LastJ	FirstJ LastJ	S	N/A	N/A		N/A			New Order
23		Bus F
24		927903822	X			8/11/2020	G	Bus F	HR	HOLD	8/11/2020	30.00	kg	FirstK	LastK	FirstK LastK	B	N/A	B		N/A			New Order
25		935501560	X			8/25/2020	G	Bus F	HR	HOLD	8/25/2020	0.85	kg	FirstL	LastL	FirstL LastL	B	N/A	B		N/A			New Order
26		913890863	X			9/17/2020	G	Bus F	HR	PICKUP	9/17/2020	4.50	kg	FirstM	LastM	FirstM LastM	B	N/A	B		N/A			New Order
27		919464568	X			9/18/2020	G	Bus F	HR	PICKUP	9/18/2020	7.12	kg	FirstN	LastN	FirstN LastN	B	N/A	B		N/A			New Order
28		983673291	X			9/19/2020	G	Bus F	HR	PICKUP	9/19/2020	2.57	kg	FirstO	LastO	FirstO LastO	B	N/A	B		N/A			New Order
29		986704704	X			9/19/2020	G	Bus F	HR	PICKUP	9/19/2020	0.92	kg	FirstP	LastP	FirstP LastP	B	N/A	B		N/A			New Order
30		909835453	X			9/20/2020	G	Bus F	HR	PICKUP	9/20/2020	2.58	kg	FirstQ	LastQ	FirstQ LastQ	B	N/A	B		N/A			New Order
31		980933402	X			9/21/2020	G	Bus F	HR	PICKUP	9/21/2020	5.45	kg	FirstR	LastR	FirstR LastR	B	N/A	B		N/A			New Order
32		985392678	X			8/10/2020	P	Bus F	HR	HOLD	8/9/2020	2.82	kg	FirstS	LastS	FirstS LastS	S	N/A	N/A		N/A			New Order
33		964457805	X			8/21/2020	P	Bus F	HR	PICKUP	8/21/2020	5.54	kg	FirstT	LastT	FirstT LastT	S	N/A	N/A		N/A			New Order
34		948238693	X			9/17/2020	P	Bus F	HR	PICKUP	9/17/2020	12.10	kg	FirstU	LastU	FirstU LastU	S	N/A	N/A		N/A			New Order
35		949746376	X			9/17/2020	P	Bus F	HR	PICKUP	9/17/2020	4.60	kg	FirstV	LastV	FirstV LastV	S		N/A		N/A			New Order	09-15-2020				10010
36		947673756	X			9/18/2020	P	Bus F	HR	PICKUP	9/18/2020	35.80	kg	FirstW	LastW	FirstW LastW	S	N/A	N/A		N/A			New Order
37		922170473	X			9/18/2020	P	Bus F	HR	PICKUP	9/18/2020	44.20	kg	FirstX	LastX	FirstX LastX	S	N/A	N/A		N/A			New Order
38		974500334	X			9/19/2020	P	Bus F	HR	PICKUP	9/19/2020	6.62	kg	FirstY	LastY	FirstY LastY	S	N/A	N/A		N/A			New Order
39		949791397	X			9/19/2020	P	Bus F	HR	PICKUP	9/19/2020	2.32	kg	FirstZ	LastZ	FirstZ LastZ	S	N/A	N/A		N/A			New Order
40		977607564	X			9/19/2020	P	Bus F	HR	PICKUP	9/19/2020	5.09	kg	FirstAB	LastAB	FirstAB LastAB	S	N/A	N/A		N/A			New Order
41		914824074	X			9/20/2020	P	Bus F	HR	PICKUP	9/20/2020	3.40	kg	FirstAC	LastAC	FirstAC LastAC	S	N/A	N/A		N/A			New Order
42		970815497	X			6/13/2020	W	Bus F	HR	HOLD	6/13/2020	5.00	kg	FirstAD	LastAD	FirstAD LastAD	B	N/A	B		N/A			New Order
43		924503984	X			9/19/2020	W	Bus F	HR	PICKUP	9/19/2020	0.33	kg	FirstAE	LastAE	FirstAE LastAE	B	N/A	B		N/A			New Order
Manage All Orders

Cell Formulas
Range	Formula
U4,P24:P43,P22,P19:P20,P17,P14:P15,P9:P12,P7,P4:P5	U4	=S4&" "&T4
C7,C24:C43,C22,C19:C20,C17,C14:C15,C9:C12	C7	=IF(COUNTIF($A:$A,$B7)=0,"X","PICKUP")

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
D:D	Cell Value	="CONFIRMED"	text	NO
C:C	Cell Value	="PICKUP"	text	NO
T3:T584	Expression	=$S3="LASER"	text	NO
T3:T584	Expression	=$S3="BRASS"	text	NO
S:S	Cell Value	="LASER"	text	NO
S:S	Cell Value	="BRASS"	text	NO
Q:Q	Cell Value	="PTH-KEEP Sake"	text	NO
Q:Q	Cell Value	="STANDARD"	text	NO
U:U	Cell Value	="INK"	text	NO
U:U	Cell Value	="PAWPAL"	text	NO
J:J	Cell Value	="HOLD"	text	NO
L4:P584,L2:M3,O2:P3	Expression	=$G2="PRIVATE"	text	NO
Q:Q	Cell Value	="ODYSSEY PEWTER"	text	NO
Q:Q	Cell Value	="CERAMIC"	text	NO
Q:Q	Cell Value	="ROSEWOOD"	text	NO
Q:Q	Cell Value	="PTH"	text	NO
Q:Q	Cell Value	="CEDAR"	text	NO
Q:Q	Cell Value	="SCATTER"	text	NO
H:H	Cell Value	="CONFIRMED"	text	NO
G:G	Cell Value	="PICKUP"	text	NO
Y2:Y611	Expression	=$X2="LASER"	text	NO
Y2:Y611	Expression	=$X2="BRASS"	text	NO
X:X	Cell Value	="LASER"	text	NO
X:X	Cell Value	="BRASS"	text	NO
V:V	Cell Value	="PTH-KEEP Sake"	text	NO
V:V	Cell Value	="STANDARD"	text	NO
Z:Z	Cell Value	="INK"	text	NO
Z:Z	Cell Value	="PAWPAL"	text	NO
N4:N1048576,N1,S2	Cell Value	="HOLD"	text	NO
Q2:U611	Expression	=$K2="PRIVATE"	text	NO
V:V	Cell Value	="ODYSSEY PEWTER"	text	NO
V:V	Cell Value	="CERAMIC"	text	NO
V:V	Cell Value	="ROSEWOOD"	text	NO
V:V	Cell Value	="PTH"	text	NO
V:V	Cell Value	="CEDAR"	text	NO
V:V	Cell Value	="SCATTER"	text	NO
S2	Expression	=$G3="PRIVATE"	text	NO
T2	Expression	=#REF!="LASER"	text	NO
T2	Expression	=#REF!="BRASS"	text	NO

01-PU Template-Test.xltm
	A	B	C	D	E	F
1	#	CO	FIRSTNAME	LASTNAME	ID TAG #	DATE
2	1	Bus F	FirstV	LastV	10010	9/15/2020
3	2	Bus C	FirstG	LastG	10008	9/21/2020
4	3	BusA	FirstD	LastD	10001	9/20/2020
5	4
6	5
7	6
8	7
9	8
10	9
11	10
12	11
13	12
14	13
15	14
16	15
17	16
18	17
19	18
20	19
21	20
22	21
23	22
24	23
25	24
26	25
27	26
28	27
29	28
30	29
31	30
32	31
33	32
34	33
35	34
36	35
37	36
List

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B2	Expression	=$G2="PRIVATE"	text	NO

 

[JLGWhiz]

This in worksheet code module:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rangeToChange As Range
Set rangeToChange = Range("AC9:AC200")
'Run the code when a cell within a range is changed.
    If Not Intersect(Target, rangeToChange) Is Nothing Then
    If Not IsNumeric(Target.Value) Then Exit Sub
'Run a macro that is located inside a Module
Call Another_Macro(Target.Row, ActiveSheet.Name)
End If
End Sub

and this in public code module1:

Sub Another_Macro(rw As Long, shNm As String)
Dim ary As Variant
ary = Array("H", "N", "O", "AC", "Y")
    For i = LBound(ary) To UBound(ary)
        If Application.CountA(Sheets("List").Rows(2)) = 0 Then
            Sheets("List").Cells(2, i + 2) = Sheets(shNm).Range(ary(i) & rw).Value
        Else
            Sheets("List").Cells(Rows.Count, i + 2).End(xlUp)(2) = _
            Sheets(shNm).Range(ary(i) & rw).Value
        End If
    Next
End Sub

 

[ARL]

Thank You JLGWhiz, works like a charm. Have spent and hour on my test file and it is working perfect.

 

[JLGWhiz]

Thank You JLGWhiz, works like a charm. Have spent and hour on my test file and it is working perfect.

You're welcome,
regards, JLG