W
wynand
Please help!
The problem code is as follows::
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Change the ranges if required
If Intersect(Target, Range("D14
20,B29
35") Is Nothing Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error GoTo GetOut
Range("D21:F21,I21:K21,N21
21,D36:F21,I36:K21,N36
21").Copy
Range("T29:V21").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("B10,G10,L10,B25,G25,L25").Copy Destination:=Range("S29")
Application.CutCopyMode = False
Range("S29:V34").Sort Key1:=Range("S29"), _
Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight
Target.Offset(0, 1).Select
GetOut:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I received and adapted another code to fit my range.
The code is not working. I'm trying to automaticly sort three sumtotals in
different cell references (D21
21 etc) to the relevant names (B10,G10 etc)
in a different location on the same sheet.
The problem code is as follows::
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Change the ranges if required
If Intersect(Target, Range("D14


Application.EnableEvents = False
Application.ScreenUpdating = False
On Error GoTo GetOut
Range("D21:F21,I21:K21,N21


Range("T29:V21").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("B10,G10,L10,B25,G25,L25").Copy Destination:=Range("S29")
Application.CutCopyMode = False
Range("S29:V34").Sort Key1:=Range("S29"), _
Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight
Target.Offset(0, 1).Select
GetOut:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I received and adapted another code to fit my range.
The code is not working. I'm trying to automaticly sort three sumtotals in
different cell references (D21

in a different location on the same sheet.