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

ARL

New Member
Joined
Jun 26, 2020
Messages
5
Office Version
  1. 365
Platform
  1. Windows
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
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABAC
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"
3FOR 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"
4The rows change daily  
5 **Would be handy if the Date Field had a pop up CalanderTRIGGER
6Vet
7OrderXSubmittedProductCOSubmitted ByPickUpProsWghtUnitFirstLastFirst LastProdPendEngTextPrintInstructionsPickUpStatusDateTimeByPosID Tag
8Bus A
9928041622X9/8/2020GBus AWSPICKUP9/8/20201.60kgFirstALastAFirstA LastABN/ABN/ANew Order
10905262048X9/19/2020GBus AWSPICKUP9/19/202010.00kgFirstBLastBFirstB LastBBN/ABN/ANew Order
11905603633X9/19/2020GBus AWSPICKUP9/19/20209.00kgFirstCLastCFirstC LastCBN/ABN/ANew Order
12995559283X9/19/2020PBus AWSPICKUP9/19/20203.50kgFirstDLastDFirstD LastDSN/AN/AN/ANew Order09-20-202010001
13Bus B
14950459251X5/12/2020GBus BJAHOLD5/12/20205.90kgFirstELastEFirstE LastEBN/ABN/ANew Order
15984343141X9/20/2020GBus BJAPICKUP9/20/20202.60kgFirstFLastFFirstF LastFBN/ABN/ANew Order
16Bus C
17976804658X9/19/2020PBus CTPPICKUP9/19/20202.29kgFirstGLastGFirstG LastGSN/AN/AN/ANew Order09-21-202010008
18Bus D
19977842513X8/29/2020PBus DJBHOLD8/29/20206.00lbFirstHLastHFirstH LastHSN/AN/AN/ANew Order
20969609313X9/9/2020PBus DJBPICKUP9/9/20207.80lbFirstILastIFirstI LastISN/ABRMCN/ANew Order
21Bus E
22908999595X9/19/2020PBus EJNPICKUP9/19/202025.00lbFirstJLastJFirstJ LastJSN/AN/AN/ANew Order
23Bus F
24927903822X8/11/2020GBus FHRHOLD8/11/202030.00kgFirstKLastKFirstK LastKBN/ABN/ANew Order
25935501560X8/25/2020GBus FHRHOLD8/25/20200.85kgFirstLLastLFirstL LastLBN/ABN/ANew Order
26913890863X9/17/2020GBus FHRPICKUP9/17/20204.50kgFirstMLastMFirstM LastMBN/ABN/ANew Order
27919464568X9/18/2020GBus FHRPICKUP9/18/20207.12kgFirstNLastNFirstN LastNBN/ABN/ANew Order
28983673291X9/19/2020GBus FHRPICKUP9/19/20202.57kgFirstOLastOFirstO LastOBN/ABN/ANew Order
29986704704X9/19/2020GBus FHRPICKUP9/19/20200.92kgFirstPLastPFirstP LastPBN/ABN/ANew Order
30909835453X9/20/2020GBus FHRPICKUP9/20/20202.58kgFirstQLastQFirstQ LastQBN/ABN/ANew Order
31980933402X9/21/2020GBus FHRPICKUP9/21/20205.45kgFirstRLastRFirstR LastRBN/ABN/ANew Order
32985392678X8/10/2020PBus FHRHOLD8/9/20202.82kgFirstSLastSFirstS LastSSN/AN/AN/ANew Order
33964457805X8/21/2020PBus FHRPICKUP8/21/20205.54kgFirstTLastTFirstT LastTSN/AN/AN/ANew Order
34948238693X9/17/2020PBus FHRPICKUP9/17/202012.10kgFirstULastUFirstU LastUSN/AN/AN/ANew Order
35949746376X9/17/2020PBus FHRPICKUP9/17/20204.60kgFirstVLastVFirstV LastVSN/AN/ANew Order09-15-202010010
36947673756X9/18/2020PBus FHRPICKUP9/18/202035.80kgFirstWLastWFirstW LastWSN/AN/AN/ANew Order
37922170473X9/18/2020PBus FHRPICKUP9/18/202044.20kgFirstXLastXFirstX LastXSN/AN/AN/ANew Order
38974500334X9/19/2020PBus FHRPICKUP9/19/20206.62kgFirstYLastYFirstY LastYSN/AN/AN/ANew Order
39949791397X9/19/2020PBus FHRPICKUP9/19/20202.32kgFirstZLastZFirstZ LastZSN/AN/AN/ANew Order
40977607564X9/19/2020PBus FHRPICKUP9/19/20205.09kgFirstABLastABFirstAB LastABSN/AN/AN/ANew Order
41914824074X9/20/2020PBus FHRPICKUP9/20/20203.40kgFirstACLastACFirstAC LastACSN/AN/AN/ANew Order
42970815497X6/13/2020WBus FHRHOLD6/13/20205.00kgFirstADLastADFirstAD LastADBN/ABN/ANew Order
43924503984X9/19/2020WBus FHRPICKUP9/19/20200.33kgFirstAELastAEFirstAE LastAEBN/ABN/ANew Order
Manage All Orders
Cell Formulas
RangeFormula
U4,P24:P43,P22,P19:P20,P17,P14:P15,P9:P12,P7,P4:P5U4=S4&" "&T4
C7,C24:C43,C22,C19:C20,C17,C14:C15,C9:C12C7=IF(COUNTIF($A:$A,$B7)=0,"X","PICKUP")
Cells with Conditional Formatting
CellConditionCell FormatStop If True
D:DCell Value="CONFIRMED"textNO
C:CCell Value="PICKUP"textNO
T3:T584Expression=$S3="LASER"textNO
T3:T584Expression=$S3="BRASS"textNO
S:SCell Value="LASER"textNO
S:SCell Value="BRASS"textNO
Q:QCell Value="PTH-KEEP Sake"textNO
Q:QCell Value="STANDARD"textNO
U:UCell Value="INK"textNO
U:UCell Value="PAWPAL"textNO
J:JCell Value="HOLD"textNO
L4:P584,L2:M3,O2:P3Expression=$G2="PRIVATE"textNO
Q:QCell Value="ODYSSEY PEWTER"textNO
Q:QCell Value="CERAMIC"textNO
Q:QCell Value="ROSEWOOD"textNO
Q:QCell Value="PTH"textNO
Q:QCell Value="CEDAR"textNO
Q:QCell Value="SCATTER"textNO
H:HCell Value="CONFIRMED"textNO
G:GCell Value="PICKUP"textNO
Y2:Y611Expression=$X2="LASER"textNO
Y2:Y611Expression=$X2="BRASS"textNO
X:XCell Value="LASER"textNO
X:XCell Value="BRASS"textNO
V:VCell Value="PTH-KEEP Sake"textNO
V:VCell Value="STANDARD"textNO
Z:ZCell Value="INK"textNO
Z:ZCell Value="PAWPAL"textNO
N4:N1048576,N1,S2Cell Value="HOLD"textNO
Q2:U611Expression=$K2="PRIVATE"textNO
V:VCell Value="ODYSSEY PEWTER"textNO
V:VCell Value="CERAMIC"textNO
V:VCell Value="ROSEWOOD"textNO
V:VCell Value="PTH"textNO
V:VCell Value="CEDAR"textNO
V:VCell Value="SCATTER"textNO
S2Expression=$G3="PRIVATE"textNO
T2Expression=#REF!="LASER"textNO
T2Expression=#REF!="BRASS"textNO


01-PU Template-Test.xltm
ABCDEF
1#COFIRSTNAMELASTNAMEID TAG #DATE
21Bus FFirstVLastV100109/15/2020
32Bus CFirstGLastG100089/21/2020
43BusAFirstDLastD100019/20/2020
54
65
76
87
98
109
1110
1211
1312
1413
1514
1615
1716
1817
1918
2019
2120
2221
2322
2423
2524
2625
2726
2827
2928
3029
3130
3231
3332
3433
3534
3635
3736
List
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B2Expression=$G2="PRIVATE"textNO
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
This in worksheet code module:

VBA Code:
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:

VBA Code:
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

New Member
Joined
Jun 26, 2020
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Thank You JLGWhiz, works like a charm. Have spent and hour on my test file and it is working perfect.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,210
Messages
5,623,411
Members
415,972
Latest member
SY1234

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top